Reference to Multiple Opened Workbooks

[hansjhamm]

I have a folder with a varying number of workbooks that I need to
reference and retrieve data out. While I can get it to find all the
workbooks I can't get it to reference certain columns in those
workbooks. Then find the next available "open" column in the summary
workbook and place the data in it...

Any daylight to how I need to do this is appreciated. There have been a
few of you that has helped immensely and that is how I am learning
VB/VBA. Kudo's to you!

Here is the opening code:

Sub getdata()
Dim SpecialProjectLite As Workbook
With Application.FileSearch
.NewSearch
.LookIn = ThisWorkbook.Path
.SearchSubFolders = False
.Filename = "m*.htm"
.MatchTextExactly = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i)
Set wkbk = ActiveWorkbook

Dim cell As Range, rng As Range
Set rng = Range(Cells(1, "D"), Cells(Rows.Count, "D").End(xlUp))
For Each cell In rng
If cell = "Would you like to add any comments?" Then
cell.Offset(0, -3).ClearContents
End If
Next

Next i
Else
MsgBox "No MAP Files Found; did you save in correct folder?"
End If
End With

The second major portion of code is this and this is where I kind of
understand, but can't quite get it:
My 1st column in the "Summary" is D and I want to place data from
"M1.htm" into that column. Then find the next "m*.htm" workbook and
place that data into the next available column, E. I have tried placing
this code directly after the next and before the next i. Then change
the 'm1.htm to 'm*.htm, but I cannot get it to work properly


Windows("MAP Report Lite").Activate
Dim LastRow As Long
With Worksheets("Summary")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
With .Range("D34" & LastRow)
.Formula =
"=IF(ISERROR(INDEX('m1.htm'!$E:$E,MATCH(C34,'m1.htm'!$A:$A,0))),"""",INDEX('m1.htm'!$E:$E,MATCH(C34,'m1.htm'!$A:$A,0)))"
.Value = .Value
End With

End With

Thanks,

Hans

 

[Guest]

This is not tested, but should set you on the right track.

HTH
GS

Sub GetData()
' Searches for specified files, opens them for editing,
' then populates wksTarget with data.
' Assumes wksTarget is Sheets("Summary"),
' and is the active sheet BEFORE opening the files.

Dim wksTarget As Worksheet, wbkSource As Workbook
Dim lLastRow As Long, i As Long, iCol As Integer
Dim cell As Range, rng As Range

'Reference the wksTarget
Set wksTarget = ActiveSheet

'Initialize the start column
iCol = 4 ' "D"

With Application.FileSearch
.NewSearch
.LookIn = ThisWorkbook.Path
.SearchSubFolders = False
.fileName = "m*.htm"
.MatchTextExactly = True
.FileType = msoFileTypeExcelWorkbooks

If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Set wbkSource = Workbooks.Open(.FoundFiles(i))
'wbkSource is now the ActiveWorkbook,
'the default sheet is the ActiveSheet.

Set rng = Range(Cells(1, "D"), Cells(Rows.Count, "D").End(xlUp))
For Each cell In rng
If cell = "Would you like to add any comments?" Then
cell.Offset(0, -3).ClearContents
End If
Next cell

'Collect the data
With wksTarget
lLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
With .Range(.Cells(34, iCol), .Cells(lLastRow, iCol))
.Formula = "=IF(ISERROR(INDEX('" & wbkSource & _
"'!$E:$E,MATCH(C34,'" & wbkSource & _
"'!$A:$A,0))),"""",INDEX('" & wbkSource & _
"'!$E:$E,MATCH(C34,'" & wbkSource & "'!$A:$A,0)))"
.Value = .Value
End With
End With

'Set next column here
iCol = iCol + 1
Next i
Else
MsgBox "No MAP Files Found; did you save in correct folder?"
End If
End With
End Sub

 

[Guest]

Two issues with my post:
1. In the formula, the reference to wbkSource should be wbkSource.Name.

2. I did not include code to close wbkSource. Add this before or after the
iCol increment:

With wbkSource
.Save
.Close
End With

Regards,
GS

 

[hansjhamm]

GS,

I looked at this briefly yesterday and have not had time to really
delve into it, but when I placed in the code it ran without any data
being retrieved. Will keep you posted on my status. Thanks for the
help!!

Hans