Need help for a loop

[Guest]

Hi folks,

My following code is working ok if I only need to pull in couple cells of
data from each spreadsheet.

Dim strFolder As String
Dim strFile As String


strFolder = "c:\NewFolder\"
strFile = Dir("c:\NewFolder\*.xls")

If Len(Dir(strFolder, vbDirectory)) = 0 Then
MsgBox "Folder does not exist."
Exit Sub
End If

Workbooks.Add
Worksheets(1).Name = "Data"
ActiveWorkbook.SaveAs Filename:="c:\NewFolder2\test" & _
Format(Date, "mmddyy") & ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False

Worksheets("Data").Range("A1") = "F1"
Worksheets("Data").Range("B1") = "F2"

i = 2

Do While Len(strFile) > 0
With Worksheets("Data").Cells(i, 1)
.Value = "='" & strFolder & "[" & strFile & "]" & "Data" &
"'!C8"
.Value = .Value
End With
strFile = Dir()
i = i + 1
Loop


End Sub

So far, I have over hundred of cells data in each spreadsheet to pull in.
It will kill me to define all the column heading and cell ID in the code. I
would like to create a spreadsheet call "Structure" and have the following
data:

Field Name Cell ID
F1 C8
F2 D1
F3 H4

Then have a loop in my code to automatice loop through the sheet to pull in
the column name and Cell ID. The loop need to be a dynamic loop because the
Field will be increase or decrease. I tried so many ways but could not work
out. Please show me how to do the loop.

Any help will be appreciated.

Tim.

 

[Tom Ogilvy]

with Worksheets("Structure")
set rng = .range(.Cells(1,1),.Cells(1,1).End(xldown))
End with


then later

Do While Len(strFile) > 0
for each cell in rng
sField = Cell.Value
sCell = cell.offset(0,1).Value
col = Application.Match(sField,worksheets("Data").Range("A1:IV1"),0)
if not iserror(col) then
With Worksheets("Data").Cells(i, col)
.Value = "='" & strFolder & "[" & strFile & "]" & _
"Data!'" & sCell
.Value = .Value
End With
End If
Next
strFile = Dir()
i = i + 1
Loop

 

[Guest]

Thanks Tom.

Tim.

with Worksheets("Structure")
set rng = .range(.Cells(1,1),.Cells(1,1).End(xldown))
End with


then later

Do While Len(strFile) > 0
for each cell in rng
sField = Cell.Value
sCell = cell.offset(0,1).Value
col = Application.Match(sField,worksheets("Data").Range("A1:IV1"),0)
if not iserror(col) then
With Worksheets("Data").Cells(i, col)
.Value = "='" & strFolder & "[" & strFile & "]" & _
"Data!'" & sCell
.Value = .Value
End With
End If
Next
strFile = Dir()
i = i + 1
Loop

--
Regards,
Tom Ogilvy

Hi folks,

My following code is working ok if I only need to pull in couple cells of
data from each spreadsheet.

Dim strFolder As String
Dim strFile As String


strFolder = "c:\NewFolder\"
strFile = Dir("c:\NewFolder\*.xls")

If Len(Dir(strFolder, vbDirectory)) = 0 Then
MsgBox "Folder does not exist."
Exit Sub
End If

Workbooks.Add
Worksheets(1).Name = "Data"
ActiveWorkbook.SaveAs Filename:="c:\NewFolder2\test" & _
Format(Date, "mmddyy") & ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False

Worksheets("Data").Range("A1") = "F1"
Worksheets("Data").Range("B1") = "F2"

i = 2

Do While Len(strFile) > 0
With Worksheets("Data").Cells(i, 1)
.Value = "='" & strFolder & "[" & strFile & "]" & "Data" &
"'!C8"
.Value = .Value
End With
strFile = Dir()
i = i + 1
Loop


End Sub

So far, I have over hundred of cells data in each spreadsheet to pull in.
It will kill me to define all the column heading and cell ID in the code. I
would like to create a spreadsheet call "Structure" and have the following
data:

Field Name Cell ID
F1 C8
F2 D1
F3 H4

Then have a loop in my code to automatice loop through the sheet to pull in
the column name and Cell ID. The loop need to be a dynamic loop because the
Field will be increase or decrease. I tried so many ways but could not work
out. Please show me how to do the loop.

Any help will be appreciated.

Tim.