Select Case statement skipping the cases

L

Legacy 93538

Guest
Hi

I am using Excel 2010 and I am having trouble with a select case loop statement macro i have writen it works and runs without errors except its either skipping the select case statement or its not find the files.

Rich (BB 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.xl sx"

Application.Workbooks.Open "C:\Documents and Settings\SeymourJ\Desktop\Actual_Participation_02_ 2011.xls"

Workbooks("Actual_Participation_02_2011.xls").Shee ts(1).Range("A2:A1000").Copy Destination:=Workbooks("GraphingChartTemplate.xlsx ").Sheets("Graphing").Range("B3")

Workbooks("Actual_Participation_02_2011.xls").Clos e

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("MT H")
wsMyCsvSheet.Range("A2:M14").Copy
Workbooks("GraphingChartTemplate.xlsx").Sheets("MT H").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("MT HPrevious")
wsMyCsvSheet.Range("A2:M14").Copy
Workbooks("GraphingChartTemplate.xlsx").Sheets("MT HPrevious").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("YT D")
wsMyCsvSheet.Range("A2:M14").Copy
Workbooks("GraphingChartTemplate.xlsx").Sheets("YT D").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("YT DPrevious")
wsMyCsvSheet.Range("A2:M14").Copy
Workbooks("GraphingChartTemplate.xlsx").Sheets("YT DPrevious").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("R1 2")
wsMyCsvSheet.Range("A2:M14").Copy
Workbooks("GraphingChartTemplate.xlsx").Sheets("R1 2").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("R1 2Previous")
wsMyCsvSheet.Range("A2:M14").Copy
Workbooks("GraphingChartTemplate.xlsx").Sheets("R1 2Previous").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

Does anyone know why it is either skipping the select case statement or its not find the files because i am not sure?

Thanks

Jessicaseymour
 
Sort by date Sort by votes
Not tested in any way, please back up the GraphingChartTemplate file before proceding.

Code: 
Option Explicit
Sub RunCodeOnAllXLSFiles()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
Dim Nrow As Long, Nrow1 As Long, Nrow2 As Long, Nrow3 As Long, Nrow4 As Long, Nrow5 As Long
Dim strFldr As String, strFile As String, strFile1 As String, strFile2 As String
Dim strFile3 As String, strFile4 As String, strFile5 As String, i As String, l As String
Dim lCount As Long, wbResults As Workbook, wbCodeBook As Workbook, wbGCT As Workbook
    Set wbGCT = Workbooks("GrpahingChartTemplate.xlsx")
        strFldr = "C:\Documents and Settings\SeymourJ\My Documents\Tasks"
        strFile = "*Graphing_MTH_Actual_Curr_Year*.CSV"
        strFile1 = "*Graphing_MTH_Actual_Prev_Year*.CSV"
        strFile2 = "*Graphing_YTD_Actual_Curr_Year*.CSV"
        strFile3 = "*Graphing_YTD_Actual_Prev_Year*.CSV"
        strFile4 = "*Graphing_R12_Actual_Curr_Year*.CSV"
        strFile5 = "*Graphing_R12_Actual_Prev_Year*.CSV"
Nrow = 2: Nrow1 = 2: Nrow2 = 2: Nrow3 = 2: Nrow4 = 2: Nrow5 = 2
    i = Range("B7").Value: l = Range("B8").Value
        Application.Workbooks.Open "C:\Documents and Settings\SeymourJ\Desktop\GraphingChartTemplate.xl sx"
        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
On Error Resume Next
    Set wbCodeBook = ThisWorkbook
        With Application.FileSearch
            .NewSearch
            .LookIn = strFldr
            .FileType = msoFileTypeExcelWorkbooks
            .Filename = "Graphing_*_Actual_*_Year*.CSV"
                If .Execute > 0 Then
                    For lCount = 1 To .FoundFiles.Count
                        Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
    wbResults.Sheets(1).Range("A2:M14").Copy
Select Case wbResults.Name
    Case strFile
        wbGCT.Sheets("MT H").Cells(Nrow, 2).PasteSpecial
        Nrow = Nrow + 14
    Case strFile1
        wbGCT.Sheets("MT HPrevious").Cells(Nrow1, 2).PasteSpecial
        Nrow1 = Nrow1 + 14
    Case strFile2
        wbGCT.Sheets("YT D").Cells(Nrow2, 2).PasteSpecial
        Nrow2 = Nrow2 + 14
    Case strFile3
        wbGCT.Sheets("YT DPrevious").Cells(Nrow3, 2).PasteSpecial
        Nrow3 = Nrow3 + 14
    Case strFile4
        wbGCT.Sheets("R1 2").Cells(Nrow4, 2).PasteSpecial
        Nrow4 = Nrow4 + 14
    Case strFile5
        wbGCT.Sheets("R1 2Previous").Cells(Nrow5, 2).PasteSpecial
        Nrow5 = Nrow5 + 14
End Select
                        wbResults.Close SaveChanges:=False
                Application.StatusBar = strFile
                   Next lCount
                End If
        End With
On Error GoTo 0
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End Sub
 
Last edited:
Upvote 0

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
hi

Thank you so much for helping!

I have ran the code you gave me and it gave an error when it got to
Code: 
 Set wbGCT = Workbooks("GrpahingChartTemplate.xlsx")

The error was Invalid Procedure call or argument
 
Upvote 0
Oops

Rich (BB code): 
Set wbGCT = Workbooks("GraphingChartTemplate.xlsx")
 
Upvote 0
Hi

Dont worry my spelling (and grammar) is awful!

I have changed it and run it again and its still producing an error on the same line but the error is subscript out of range
 
Upvote 0
Also i have just noticed that you have used FileSearch, Excel 2010 does not support this anymore (Dont know why) which is probably causing the problem
 
Upvote 0
Jessicaseymour said:
Also i have just noticed that you have used FileSearch, Excel 2010 does not support this anymore (Dont know why) which is probably causing the problem
Click to expand...

That probably isn't going to help, I can't find any reason why that line is causing an error though, unless it only works with open files :confused:

See if this gets past it (copy the whole code, I found a few stray spaces that could cause other problems, which I have now cleared).

Code: 
Option Explicit
Sub RunCodeOnAllXLSFiles()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
Dim Nrow As Long, Nrow1 As Long, Nrow2 As Long, Nrow3 As Long, Nrow4 As Long, Nrow5 As Long
Dim strFldr As String, strFile As String, strFile1 As String, strFile2 As String
Dim strFile3 As String, strFile4 As String, strFile5 As String, i As String, l As String
Dim lCount As Long, wbResults As Workbook, wbCodeBook As Workbook, wbGCT As Workbook
        strFldr = "C:\Documents and Settings\SeymourJ\My Documents\Tasks"
        strFile = "*Graphing_MTH_Actual_Curr_Year*.CSV"
        strFile1 = "*Graphing_MTH_Actual_Prev_Year*.CSV"
        strFile2 = "*Graphing_YTD_Actual_Curr_Year*.CSV"
        strFile3 = "*Graphing_YTD_Actual_Prev_Year*.CSV"
        strFile4 = "*Graphing_R12_Actual_Curr_Year*.CSV"
        strFile5 = "*Graphing_R12_Actual_Prev_Year*.CSV"
Nrow = 2: Nrow1 = 2: Nrow2 = 2: Nrow3 = 2: Nrow4 = 2: Nrow5 = 2
    i = Range("B7").Value: l = Range("B8").Value
        Application.Workbooks.Open "C:\Documents and Settings\SeymourJ\Desktop\GraphingChartTemplate.xlsx"
        Set wbGCT = Workbooks("GrpahingChartTemplate.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
On Error Resume Next
    Set wbCodeBook = ThisWorkbook
        With Application.FileSearch
            .NewSearch
            .LookIn = strFldr
            .FileType = msoFileTypeExcelWorkbooks
            .Filename = "Graphing_*_Actual_*_Year*.CSV"
                If .Execute > 0 Then
                    For lCount = 1 To .FoundFiles.Count
                        Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
    wbResults.Sheets(1).Range("A2:M14").Copy
Select Case wbResults.Name
    Case strFile
        wbGCT.Sheets("MT H").Cells(Nrow, 2).PasteSpecial
        Nrow = Nrow + 14
    Case strFile1
        wbGCT.Sheets("MT HPrevious").Cells(Nrow1, 2).PasteSpecial
        Nrow1 = Nrow1 + 14
    Case strFile2
        wbGCT.Sheets("YT D").Cells(Nrow2, 2).PasteSpecial
        Nrow2 = Nrow2 + 14
    Case strFile3
        wbGCT.Sheets("YT DPrevious").Cells(Nrow3, 2).PasteSpecial
        Nrow3 = Nrow3 + 14
    Case strFile4
        wbGCT.Sheets("R1 2").Cells(Nrow4, 2).PasteSpecial
        Nrow4 = Nrow4 + 14
    Case strFile5
        wbGCT.Sheets("R1 2Previous").Cells(Nrow5, 2).PasteSpecial
        Nrow5 = Nrow5 + 14
End Select
                        wbResults.Close SaveChanges:=False
                Application.StatusBar = strFile
                   Next lCount
                End If
        End With
On Error GoTo 0
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End Sub

Next problem is finding an alternative to filesearch :(
 
Upvote 0
Hi

ok i have tried your new code and its still producing the same error on the same line!

It would be easier if Excel would keep the same VBA coding for every version but oh well!!
 
Upvote 0
What if you delete

Code: 
        Application.Workbooks.Open "C:\Documents and Settings\SeymourJ\Desktop\GraphingChartTemplate.xlsx"
        Set wbGCT = Workbooks("GrpahingChartTemplate.xlsx")
and replace with

Code: 
Set wbGCT = Workbooks.Open("C:\Documents and Settings\SeymourJ\Desktop\GraphingChartTemplate.xlsx")

I've found the alternative for FileSearch, now just need to figure out the edit (between the other bugs).
 
Upvote 0
Hi

i have fixed the error i forgot about the spelling so that works now just crashes when it gets to Filesearch
 
Upvote 0
Hopefully

Code: 
Sub RunCodeOnAllXLSFiles()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
Dim Nrow As Long, Nrow1 As Long, Nrow2 As Long, Nrow3 As Long, Nrow4 As Long, Nrow5 As Long
Dim strF As String, strFldr As String, strFile As String, strFile1 As String, strFile2 As String
Dim strFile3 As String, strFile4 As String, strFile5 As String, i As String, l As String
Dim wbResults As Workbook, wbGCT As Workbook
        
        strFldr = "C:\Documents and Settings\SeymourJ\My Documents\Tasks"
        strFile = "*Graphing_MTH_Actual_Curr_Year*.CSV"
        strFile1 = "*Graphing_MTH_Actual_Prev_Year*.CSV"
        strFile2 = "*Graphing_YTD_Actual_Curr_Year*.CSV"
        strFile3 = "*Graphing_YTD_Actual_Prev_Year*.CSV"
        strFile4 = "*Graphing_R12_Actual_Curr_Year*.CSV"
        strFile5 = "*Graphing_R12_Actual_Prev_Year*.CSV"
Nrow = 2: Nrow1 = 2: Nrow2 = 2: Nrow3 = 2: Nrow4 = 2: Nrow5 = 2
    i = Range("B7").Value: l = Range("B8").Value
        Set wbGCT = 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
ChDir strFldr
strF = Dir("Graphing_*_Actual_*_Year*.csv")
Do While strF <> ""
Set wbResults = Workbooks.Open(strFldr & "\" & strF)
        wbResults.Sheets(1).Range("A2:M14").Copy
Select Case wbResults.Name
    Case strFile
        wbGCT.Sheets("MT H").Cells(Nrow, 2).PasteSpecial
        Nrow = Nrow + 14
    Case strFile1
        wbGCT.Sheets("MT HPrevious").Cells(Nrow1, 2).PasteSpecial
        Nrow1 = Nrow1 + 14
    Case strFile2
        wbGCT.Sheets("YT D").Cells(Nrow2, 2).PasteSpecial
        Nrow2 = Nrow2 + 14
    Case strFile3
        wbGCT.Sheets("YT DPrevious").Cells(Nrow3, 2).PasteSpecial
        Nrow3 = Nrow3 + 14
    Case strFile4
        wbGCT.Sheets("R1 2").Cells(Nrow4, 2).PasteSpecial
        Nrow4 = Nrow4 + 14
    Case strFile5
        wbGCT.Sheets("R1 2Previous").Cells(Nrow5, 2).PasteSpecial
        Nrow5 = Nrow5 + 14
End Select
                        wbResults.Close SaveChanges:=False
                Application.StatusBar = strFile
   strF = Dir
Loop
                
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question
Simplyfying My Macro
Replies
2
Views
295
ian0886
I
N
  • Question
print out previous line
Replies
0
Views
463
newbie453
N
T
  • Question
Run-time error '-2147418113 (8000ffff)': Automation error Catastrophic failur
Replies
4
Views
3K
TTUK
T
F
  • Question
Case with like
Replies
7
Views
756
GTO
G
P
  • Question
Trying to use VBA to Save a CSV File
Replies
1
Views
455
JLGWhiz
JLGWhiz

Forum statistics

Threads
1,215,920
Messages
6,127,709
Members
449,399
Latest member
VEVE4014

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