select file from which to extract specific data

[Tel]

Hi Guys,

I have developed a spreadsheet that acts as a questionnaire - no problems
there. I'm expecting in excess of 1000 returns which will be saved in a
specific folder (to be determined). For the purposes of clarity I'll call
them source files.

I want to create a master file - destination file - that will allow the user
to browse to the source file and select it, the macro will then:

From Source File, Select Sheet Summary! Cells D2 to D33 paste to destination
file, sheet1 cells c2 to c33

and either

take the Source File filename and insert it into destination file sheet C1 or
From Source File, Select Sheet Remediation Plan! Cells C2 & F2 and paste (as
values) into destination file as C2 & " " & F2 into cell C1 -

cells in rows 2 to 33 in the destination file will be conditionally
formatted dependent upon value

then insert a column into column C (to allow for future inserts) retaining
the conditional formatting and close the source file.

If this can be done as seamlessly as possible I'd be grateful. I'm slowly
gaining an increasing knowledge of Macros but if you could be as specific as
possible it would mean a lot.

Thanks guys,

Terry

 

[JLatham]

I believe this will do the trick for you. Don't have time this morning to
test, so if it gives you problems, post back and I'll revisit the discussion
this evening:

Copy all of this and paste into a regular code module, call the
OpenAndCopy() macro to test it out.

Sub OpenAndCopy()
Dim sourceWB As Workbook
Dim sourceRange As Range
Dim sourceFilePath As String

sourceFilePath = SelectFileForUse()
If sourceFilePath = "" Then
'no file selected
Exit Sub
End If
'open the source book, no updates, read only
Workbooks.Open sourceFilePath, False, True
'it becomes the active workbook when opened
Set sourceWB = ActiveWorkbook
'return to this workbook
ThisWorkbook.Activate
ThisWorkbook.Worksheets("Sheet1").Range("C1") = _
sourceWB.FullName ' full path & name
sourceWB.Worksheets("Summary").Range("D233").Copy
ThisWorkbook.Worksheets("Sheet1").Range("C2") _
.PasteSpecial xlPasteValues
'close the source, we're done with it
sourceWB.Close False ' close w/o saving changes
Set sourceWB = Nothing
ThisWorkbook.Worksheets("Sheet1").Range("C1"). _
EntireColumn.Insert
ThisWorkbook.Worksheets("Sheet1").Range("C2:C33").Copy
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub

Function SelectFileForUse() As String
'either return
'with full well-formed path and filename to file selected
'or
'an empty string if user doesn't choose a file
'
Dim fd As FileDialog
Dim vrtSelectedItem As Variant

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Use a With...End With block to reference the FileDialog object.
With fd
'display the File Picker dialog box and
'return the user's action.
'The user pressed the action button.
If .Show = -1 Then
'Step through each selected entry
'actually only in this case
For Each vrtSelectedItem In .SelectedItems
'vrtSelectedItem is a String
'that contains the path of each selected item.
SelectFileForUse = vrtSelectedItem
Next vrtSelectedItem
'The user pressed Cancel.
Else
SelectFileForUse = ""
End If
End With
'Set the object variable to Nothing.
Set fd = Nothing
End Function

 

[Tel]

Dear "J"

This is brilliant and it works - thank you so much.

because the filename and path gave me such a long string I've adjusted it to
extract the data from the cells. It will also give me increased flexibility
if I need to sort or filter the data.

One more query relating to this, how do I, as part of the process, make the
columns shrink to fit (I've aligned cells C1 and C2 at 90 degrees) and centre
them?

I intend to assign this macros to a button so all the user has to do is
press button and select the file. Then I will add in macros to sort by row 1
or row 2.

Thank you again.

Terry

Apologies for the long reply, but I've pasted your code "tweaked by me"
below for others to take and use at will.

Sub OpenAndCopy()
Dim sourceWB As Workbook
Dim sourceRange As Range
Dim sourceFilePath As String

sourceFilePath = SelectFileForUse()
If sourceFilePath = "" Then
'no file selected
Exit Sub
End If
'open the source book, no updates, read only
Workbooks.Open sourceFilePath, False, True
'it becomes the active workbook when opened
Set sourceWB = ActiveWorkbook
'return to this workbook
ThisWorkbook.Activate
sourceWB.Worksheets("Remediation Plan").Range("C2").Copy
ThisWorkbook.Worksheets("Sheet1").Range("C1") _
.PasteSpecial xlPasteValues
sourceWB.Worksheets("Remediation Plan").Range("F2").Copy
ThisWorkbook.Worksheets("Sheet1").Range("C2") _
.PasteSpecial xlPasteValues
sourceWB.Worksheets("Summary").Range("D233").Copy
ThisWorkbook.Worksheets("Sheet1").Range("C3") _
.PasteSpecial xlPasteValues
'close the source, we're done with it
sourceWB.Close False ' close w/o saving changes
Set sourceWB = Nothing
ThisWorkbook.Worksheets("Sheet1").Range("C1"). _
EntireColumn.Insert
ThisWorkbook.Worksheets("Sheet1").Range("C2:C33").Copy
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub

Function SelectFileForUse() As String
'either return
'with full well-formed path and filename to file selected
'or
'an empty string if user doesn't choose a file
'
Dim fd As FileDialog
Dim vrtSelectedItem As Variant

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Use a With...End With block to reference the FileDialog object.
With fd
'display the File Picker dialog box and
'return the user's action.
'The user pressed the action button.
If .Show = -1 Then
'Step through each selected entry
'actually only in this case
For Each vrtSelectedItem In .SelectedItems
'vrtSelectedItem is a String
'that contains the path of each selected item.
SelectFileForUse = vrtSelectedItem
Next vrtSelectedItem
'The user pressed Cancel.
Else
SelectFileForUse = ""
End If
End With
'Set the object variable to Nothing.
Set fd = Nothing
End Function

 

[JLatham]

Glad to hear it worked as I intended it to even though all I really tested
was the select & open file process (a canned one I have laying around, no
doubt kibitzed from someone else).
For the moment you could record a new macro doing the column C setup
(shrinking to fit) and look at what it recorded. You should be able to copy
the working part of the code recorded and stick it in right after the
..PasteSpecial of the data into C2:C38 range and before it inserts a new
column C. Again I'm rushed a bit for time (passing thru during lunch), and
if you have problems adapting the code, just post back and I'll help some
more this evening.