Changing a loop so it loops though a list

  • Thread starter Thread starter Legacy 93538
  • Start date Start date
L

Legacy 93538

Guest
Hi

I am in need of help as i have no diea how to solve a problem

I ahve a macro which loops though all the files in three folders without problem but i have been told i need to change it so it loops though a list in the range "B1:H2000" and also include error handling so that if a file is not on the list it will skip it and go to the next filename.

Thsi is my loop so far:

Rich (BB code): 
varFolder = Array(strFldr, strFldr2, strFldr3)
 
For lngMyCount = 1 To 3
ChDir varFolder(lngMyCount)
strF = Dir("Graphing_*_Actual_*_Year*.csv")
Do While strF <> ""
Set wbResults = Workbooks.Open(varFolder(lngMyCount) & "\" & strF)
        wbResults.Sheets(1).Range("A2:FF15").Copy
 
If wbResults.Name Like strFile Then
        wbNew.Sheets("MTH").Cells(Nrow, 2).PasteSpecial
        Nrow = Nrow + 14
    ElseIf wbResults.Name Like strFile1 Then
        wbNew.Sheets("MTHPrevious").Cells(Nrow1, 2).PasteSpecial
        Nrow1 = Nrow1 + 14
    ElseIf wbResults.Name Like strFile2 Then
        wbNew.Sheets("YTD").Cells(Nrow2, 2).PasteSpecial
        Nrow2 = Nrow2 + 14
    ElseIf wbResults.Name Like strFile3 Then
        wbNew.Sheets("YTDPrevious").Cells(Nrow3, 2).PasteSpecial
        Nrow3 = Nrow3 + 14
    ElseIf wbResults.Name Like strFile4 Then
        wbNew.Sheets("R12").Cells(Nrow4, 2).PasteSpecial
        Nrow4 = Nrow4 + 14
    ElseIf wbResults.Name Like strFile5 Then
        wbNew.Sheets("R12Previous").Cells(Nrow5, 2).PasteSpecial
        Nrow5 = Nrow5 + 14
    ElseIf wbResults.Name Like strFile6 Then
        wbNew.Sheets("MTH").Cells(Nrow, 2).PasteSpecial
        Nrow = Nrow + 14
    ElseIf wbResults.Name Like strFile7 Then
        wbNew.Sheets("MTHPrevious").Cells(Nrow1, 2).PasteSpecial
        Nrow1 = Nrow1 + 14
    ElseIf wbResults.Name Like strFile8 Then
        wbNew.Sheets("MTH").Cells(Nrow2, 2).PasteSpecial
        Nrow2 = Nrow2 + 14
    ElseIf wbResults.Name Like strFile9 Then
        wbNew.Sheets("MTHPrevious").Cells(Nrow3, 2).PasteSpecial
        Nrow3 = Nrow3 + 14
    ElseIf wbResults.Name Like strFile10 Then
        wbNew.Sheets("YTD").Cells(Nrow4, 2).PasteSpecial
        Nrow4 = Nrow4 + 14
     ElseIf wbResults.Name Like strFile11 Then
        wbNew.Sheets("YTDPrevious").Cells(Nrow5, 2).PasteSpecial
        Nrow5 = Nrow5 + 14
    ElseIf wbResults.Name Like strFile12 Then
        wbNew.Sheets("YTD").Cells(Nrow5, 2).PasteSpecial
        Nrow5 = Nrow5 + 14
    ElseIf wbResults.Name Like strFile13 Then
        wbNew.Sheets("YTDPrevious").Cells(Nrow5, 2).PasteSpecial
        Nrow5 = Nrow5 + 14
    ElseIf wbResults.Name Like strFile14 Then
        wbNew.Sheets("R12").Cells(Nrow5, 2).PasteSpecial
        Nrow5 = Nrow5 + 14
    ElseIf wbResults.Name Like strFile15 Then
        wbNew.Sheets("R12Previous").Cells(Nrow5, 2).PasteSpecial
        Nrow5 = Nrow5 + 14
    ElseIf wbResults.Name Like strFile16 Then
        wbNew.Sheets("R12").Cells(Nrow5, 2).PasteSpecial
        Nrow5 = Nrow5 + 14
    ElseIf wbResults.Name Like strFile17 Then
        wbNew.Sheets("R12Previous").Cells(Nrow5, 2).PasteSpecial
        Nrow5 = Nrow5 + 14
End If
        wbResults.Close SaveChanges:=False
        Application.StatusBar = strF
        strF = wbGCT.Sheets("Graphing").Range("A3:A181")
Loop
Next lngMyCount

I have been told it can be done by changing the line highligthed in red so that instead of using dir it uses a celll range but i dont know how to do this without loosing the loop as i need it to loop through the three folders as well.

Can anyone help me please!!:(
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Sort by date Sort by votes
Split the routine up to make it easier:
Rich (BB code): 
varFolder = Array(strFldr, strFldr2, strFldr3)
 
For lngMyCount = 1 To 3
ChDir varFolder(lngMyCount)
strF = Dir("Graphing_*_Actual_*_Year*.csv")
Do While strF <> ""
GetValues strF
Loop
Next lngMyCount
 
'now to loop through the list in B1:H2000
for j = 2 to 9
for i=1 to 2000
strF= Range("A1").Offset(i-1, j-1).Value
GetValues strF
next i
next j
...
end Sub
 
Sub GetValues(strF as String)
Set wbResults = Workbooks.Open(varFolder(lngMyCount) & "\" & strF)
wbResults.Sheets(1).Range("A2:FF15").Copy
 
If wbResults.Name Like strFile Then
wbNew.Sheets("MTH").Cells(Nrow, 2).PasteSpecial
Nrow = Nrow + 14
ElseIf wbResults.Name Like strFile1 Then
wbNew.Sheets("MTHPrevious").Cells(Nrow1, 2).PasteSpecial
Nrow1 = Nrow1 + 14
ElseIf wbResults.Name Like strFile2 Then
wbNew.Sheets("YTD").Cells(Nrow2, 2).PasteSpecial
Nrow2 = Nrow2 + 14
ElseIf wbResults.Name Like strFile3 Then
wbNew.Sheets("YTDPrevious").Cells(Nrow3, 2).PasteSpecial
Nrow3 = Nrow3 + 14
ElseIf wbResults.Name Like strFile4 Then
wbNew.Sheets("R12").Cells(Nrow4, 2).PasteSpecial
Nrow4 = Nrow4 + 14
ElseIf wbResults.Name Like strFile5 Then
wbNew.Sheets("R12Previous").Cells(Nrow5, 2).PasteSpecial
Nrow5 = Nrow5 + 14
ElseIf wbResults.Name Like strFile6 Then
wbNew.Sheets("MTH").Cells(Nrow, 2).PasteSpecial
Nrow = Nrow + 14
ElseIf wbResults.Name Like strFile7 Then
wbNew.Sheets("MTHPrevious").Cells(Nrow1, 2).PasteSpecial
Nrow1 = Nrow1 + 14
ElseIf wbResults.Name Like strFile8 Then
wbNew.Sheets("MTH").Cells(Nrow2, 2).PasteSpecial
Nrow2 = Nrow2 + 14
ElseIf wbResults.Name Like strFile9 Then
wbNew.Sheets("MTHPrevious").Cells(Nrow3, 2).PasteSpecial
Nrow3 = Nrow3 + 14
ElseIf wbResults.Name Like strFile10 Then
wbNew.Sheets("YTD").Cells(Nrow4, 2).PasteSpecial
Nrow4 = Nrow4 + 14
ElseIf wbResults.Name Like strFile11 Then
wbNew.Sheets("YTDPrevious").Cells(Nrow5, 2).PasteSpecial
Nrow5 = Nrow5 + 14
ElseIf wbResults.Name Like strFile12 Then
wbNew.Sheets("YTD").Cells(Nrow5, 2).PasteSpecial
Nrow5 = Nrow5 + 14
ElseIf wbResults.Name Like strFile13 Then
wbNew.Sheets("YTDPrevious").Cells(Nrow5, 2).PasteSpecial
Nrow5 = Nrow5 + 14
ElseIf wbResults.Name Like strFile14 Then
wbNew.Sheets("R12").Cells(Nrow5, 2).PasteSpecial
Nrow5 = Nrow5 + 14
ElseIf wbResults.Name Like strFile15 Then
wbNew.Sheets("R12Previous").Cells(Nrow5, 2).PasteSpecial
Nrow5 = Nrow5 + 14
ElseIf wbResults.Name Like strFile16 Then
wbNew.Sheets("R12").Cells(Nrow5, 2).PasteSpecial
Nrow5 = Nrow5 + 14
ElseIf wbResults.Name Like strFile17 Then
wbNew.Sheets("R12Previous").Cells(Nrow5, 2).PasteSpecial
Nrow5 = Nrow5 + 14
End If
wbResults.Close SaveChanges:=False
Application.StatusBar = strF
strF = wbGCT.Sheets("Graphing").Range("A3:A181")
end sub
 
Upvote 0
Hi

Thank your for replying!

Thanks for your help but i am not sure i understand what you mean?

But i should point out annoying it has to be on one macro (even though it probably would be easier to do it in two macros)
 
Upvote 0
Why does it have to be one macro? Who is forcing you to do so? It generally is bad programming, and in this case particulary so because you will have to repeat most of the macro. You cannot combine the two loops in one.
 
Upvote 0
unfortunatly i must as its for a work project and its the way i my boss would prefer it
 
Upvote 0
In the answer sijpie gave you just replace the line "GetValues strf" with the entire contents of the GetValues sub and you have your single macro
 
Upvote 0
it's friggin daft to have that as a restriction - it teaches bad programming, and makes your code very maintenance intensive and hard to understand. It wouldn't harm to tell your boss/instructor that.

But as vaskov says, extract the text from the sub and paste it wherever the sub name apears in the main macro.
 
Upvote 0
Hi

Thanks for your help!!

But i ran it as said and its looking at the wrong columns in the list it should be looking at B1:H20000 in the wbNew workbook on the values sheet but its looking at column A.

Also is there any way to put an error handling clause in it so that if it doesn't find something it just skips over it and moves to the next one?

Thanks

Jeskit
 
Upvote 0
Hi

I just ran the code and it works on the first file on the list but it then crashes when it gets to the second and produces an error showing "Subscript out of range" and highlights this line:

Code: 
 strF = wbNew.Sheets("Values").Range("B1:F2000")
 
Upvote 0
Where is this line of code? I don't see it in the original code.

The reason why it throws up an error is probably that strF is declared as a string, and you are trying to assign a range to it. So VBA can't comply.
Did you add this line and what is the purpose?

Looking atthe code in more detail shows that there is a similar line at the bottom, which I don't understand what it should do
(strF = wbGCT.Sheets("Graphing").Range("A3:A181"))
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question Question
workbook Open falied error
Replies
2
Views
449
Legacy 93538
L
L
  • Question Question
Changing VBA code into VBA Arrays
Replies
7
Views
584
Legacy 93538
L
L
  • Question Question
Loop through a folder using a mutiple lists
2
Replies
10
Views
984
Legacy 93538
L

Forum statistics

Threads
1,224,552
Messages
6,179,487
Members
452,917
Latest member
MrsMSalt

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top