Loop through a folder using a mutiple lists

L

Legacy 93538

Guest
(Linked to previous posted VBA Loops not pasting in correct location)

Hi

I have created a piece of code which loops througha folder and opens all the files and copies and pastes data fom a range into a certain location. However i need to change it so when it loops the file it checks the names of the file and if has certain text in paste it into different sheets.

I need it to do the following:

If it is "Graphing_MTH_Actual_Curr_Year" & "*.csv" paste data on the MTH Sheet
If it is "Graphing_MTH_Actual_Prev_Year" & "*.csv" paste data on the MTHPrevious Sheet

If it is "Graphing_YTD_Actual_Curr_Year" & "*.csv" paste data on the YTD Sheet
If it is "Graphing_YTD_Actual_Prev_Year" & "*.csv" paste data on the YTDPrevious Sheet

If it is "Graphing_R12_Actual_Curr_Year" & "*.csv" paste data on the R12 Sheet
If it is "Graphing_R12_Actual_Prev_Year" & "*.csv" paste data on the R12Previous Sheet

I have tried doing it with multiple if statements but it just crashes. I would try variables but i am unsure of how to use the.

Does anyone know how to change this loop so it checks the file name on the list above and pastes onto the correct sheet?

Code:
 strFldr = "C:\Documents and Settings\SeymourJ\My Documents\Tasks\"
strFile = Dir(strFldr & "Graphing_MTH_Actual_Curr_Year" & "*.csv")
Application.Calculation = xlCalculationManual
lNextrow = 2
If Len(strFile) > 0 Then
    Do
        Set wbCsv = Workbooks.Open(Filename:=strFldr & "\" & strFile)
        Set wsMyCsvSheet = wbCsv.Sheets(1)
        With Workbooks("Book1Template.xlsx").Sheets("MTH")
            wsMyCsvSheet.Range("A2:M14").Copy
            Workbooks("Book1Template.xlsx").Sheets("MTH").Cells(lNextrow, 2).PasteSpecial
                
        End With
            
        lNextrow = lNextrow + 14
        
    'close it
        wbCsv.Close
        
    'go to next file
        strFile = Dir
        Application.StatusBar = strFile
    Loop Until Len(strFile) = 0
End If

Thanks to anyone who can help.

Jessicaseymour
 
Hi

I have got it working to a degree. the macro runs without errors except its either skipping the select case statement or its not find the files.

This is what i have so far. can you explain why it is either skipping the select case statement or its not find the files because i am not sure?

Code:
Option Explicit
Sub AverageGraph()
Dim i As String
Dim l As String
Dim wbCsv As Workbook
Dim wsMyCsvSheet As Worksheet
Dim lNextrow As Long
Dim strFile As String
Dim strFile1 As String
Dim strFile2 As String
Dim strFile3 As String
Dim strFile4 As String
Dim strFile5 As String
Dim strFldr As String
i = Range("B7").Value
l = Range("B8").Value
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Workbooks.Open "C:\Documents and Settings\SeymourJ\Desktop\GraphingChartTemplate.xlsx"
 
Application.Workbooks.Open "C:\Documents and Settings\SeymourJ\Desktop\Actual_Participation_02_2011.xls"
 
Workbooks("Actual_Participation_02_2011.xls").Sheets(1).Range("A2:A1000").Copy Destination:=Workbooks("GraphingChartTemplate.xlsx").Sheets("Graphing").Range("B3")
Workbooks("Actual_Participation_02_2011.xls").Close
ActiveWorkbook.Sheets("Settings").Select
Range("B6").Value = i
Range("B7").Value = l
strFldr = "C:\Documents and Settings\SeymourJ\My Documents\Tasks"
strFile = Dir(strFldr & "Graphing_MTH_Actual_Curr_Year" & "*.CSV")
strFile1 = Dir(strFldr & "Graphing_MTH_Actual_Prev_Year" & "*.CSV")
strFile2 = Dir(strFldr & "Graphing_YTD_Actual_Curr_Year" & "*.CSV")
strFile3 = Dir(strFldr & "Graphing_YTD_Actual_Prev_Year" & "*.CSV")
strFile4 = Dir(strFldr & "Graphing_R12_Actual_Curr_Year" & "*.CSV")
strFile5 = Dir(strFldr & "Graphing_R12_Actual_Prev_Year" & "*.CSV")
 
Application.Calculation = xlCalculationManual
lNextrow = 2
Select Case ActiveCell.Value
Case 1
   Do
        Set wbCsv = Workbooks.Open(Filename:=strFldr & "\" & strFile)
        Set wsMyCsvSheet = wbCsv.Sheets(1)
        With Workbooks("GraphingChartTemplate.xlsx").Sheets("MTH")
            wsMyCsvSheet.Range("A2:M14").Copy
            Workbooks("GraphingChartTemplate.xlsx").Sheets("MTH").Cells(lNextrow, 2).PasteSpecial
 
        End With
        lNextrow = lNextrow + 14
 
    'close it
        wbCsv.Close
 
    'go to next file
        strFile = Dir
        Application.StatusBar = strFile
    Loop Until Len(strFile) = 0
Case 2
    Do
        Set wbCsv = Workbooks.Open(Filename:=strFldr & "\" & strFile1)
        Set wsMyCsvSheet = wbCsv.Sheets(1)
        With Workbooks("GraphingChartTemplate.xlsx").Sheets("MTHPrevious")
            wsMyCsvSheet.Range("A2:M14").Copy
            Workbooks("GraphingChartTemplate.xlsx").Sheets("MTHPrevious").Cells(lNextrow, 2).PasteSpecial
 
        End With
        lNextrow = lNextrow + 14
 
    'close it
        wbCsv.Close
 
    'go to next file
        strFile1 = Dir
        Application.StatusBar = strFile1
    Loop Until Len(strFile1) = 0
Case 3
 
    Do
        Set wbCsv = Workbooks.Open(Filename:=strFldr & "\" & strFile2)
        Set wsMyCsvSheet = wbCsv.Sheets(1)
        With Workbooks("GraphingChartTemplate.xlsx").Sheets("YTD")
            wsMyCsvSheet.Range("A2:M14").Copy
            Workbooks("GraphingChartTemplate.xlsx").Sheets("YTD").Cells(lNextrow, 2).PasteSpecial
 
        End With
        lNextrow = lNextrow + 14
 
    'close it
        wbCsv.Close
 
    'go to next file
        strFile2 = Dir
        Application.StatusBar = strFile2
    Loop Until Len(strFile2) = 0
Case 4
    Do
        Set wbCsv = Workbooks.Open(Filename:=strFldr & "\" & strFile3)
        Set wsMyCsvSheet = wbCsv.Sheets(1)
        With Workbooks("GraphingChartTemplate.xlsx").Sheets("YTDPrevious")
            wsMyCsvSheet.Range("A2:M14").Copy
            Workbooks("GraphingChartTemplate.xlsx").Sheets("YTDPrevious").Cells(lNextrow, 2).PasteSpecial
 
        End With
        lNextrow = lNextrow + 14
 
    'close it
        wbCsv.Close
 
    'go to next file
        strFile3 = Dir
        Application.StatusBar = strFile3
    Loop Until Len(strFile3) = 0
Case 5
    Do
        Set wbCsv = Workbooks.Open(Filename:=strFldr & "\" & strFile4)
        Set wsMyCsvSheet = wbCsv.Sheets(1)
        With Workbooks("GraphingChartTemplate.xlsx").Sheets("R12")
            wsMyCsvSheet.Range("A2:M14").Copy
            Workbooks("GraphingChartTemplate.xlsx").Sheets("R12").Cells(lNextrow, 2).PasteSpecial
 
        End With
        lNextrow = lNextrow + 14
 
    'close it
        wbCsv.Close
 
    'go to next file
        strFile4 = Dir
        Application.StatusBar = strFile4
    Loop Until Len(strFile4) = 0
Case 6
    Do
        Set wbCsv = Workbooks.Open(Filename:=strFldr & "\" & strFile5)
        Set wsMyCsvSheet = wbCsv.Sheets(1)
        With Workbooks("GraphingChartTemplate.xlsx").Sheets("R12Previous")
            wsMyCsvSheet.Range("A2:M14").Copy
            Workbooks("GraphingChartTemplate.xlsx").Sheets("R12Previous").Cells(lNextrow, 2).PasteSpecial
 
        End With
        lNextrow = lNextrow + 14
 
    'close it
        wbCsv.Close
 
    'go to next file
        strFile5 = Dir
        Application.StatusBar = strFile5
    Loop Until Len(strFile5) = 0
End Select
 
End Sub

Thanks

Jessicaseymour
 
Upvote 0

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.

Similar threads

L
  • Question
Replies
1
Views
401
Legacy 93538
L
L
Replies
2
Views
413
Legacy 93538
L
L
Replies
4
Views
468
Legacy 93538
L

Forum statistics

Threads
1,215,267
Messages
6,123,964
Members
449,137
Latest member
yeti1016

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