Loop through for WS names LIKE "AAA_####A" not working and throwing a runtime error 9

[juscuz419]

I have a worksheet that can contain up to 40 worksheets with a name LIKE "AAA_####A" where A can be any letter and # can be any number. I am trying to loop through each one in turn, extract data, paste it on another worksheet then go to the next worksheet. The code below is where I am, but it does not work. It throws an error code on the row in red font that the subscript is out of range. If I replace (sourcewsname) with an actual name of one of the sheets (ex MRC_4699A) the code works. Why wont the loop through work?

Sub CopyValuesBetweenWorksheets()

Dim sourceWS As Worksheet
Dim targetWS As Worksheet
Dim ws As Worksheet
Dim WSName As String
Dim wsDailySummary As Worksheet
Dim sourceWSName As String

For Each ws In ThisWorkbook.Worksheets
If ws.Name Like "???_?????" Then
sourceWSName = ws.Name
Exit For
End If

Set sourceWS = ThisWorkbook.Worksheets(sourceWSName)
Set targetWS = ThisWorkbook.Worksheets("Daily Summary")

'My code that works

Next ws
End Sub

 

[DanteAmor]

Try this:

Sub CopyValuesBetweenWorksheets()

  Dim sourceWS As Worksheet
  Dim targetWS As Worksheet
  Dim ws As Worksheet
  Dim WSName As String
  Dim wsDailySummary As Worksheet
  Dim sourceWSName As String
  
  For Each ws In ThisWorkbook.Worksheets
    If ws.Name Like "???_?????" Then
      sourceWSName = ws.Name
      Exit For
    End If
  Next ws
  
  If sourceWSName = "" Then
    MsgBox "There is no sheet with that pattern."
  Else
    Set sourceWS = ThisWorkbook.Worksheets(sourceWSName)
    Set targetWS = ThisWorkbook.Worksheets("Daily Summary")
  End If
  
End Sub

 

[juscuz419]

Other than the MsgBox block, that is the exact code that is not working and breaks at the set sourcews line.

 

[DanteAmor]

Did you try ALL the code I put in post #2

The code works with the sheet name you entered: "MRC_4699A"
But you must replace your code with mine.

 

[juscuz419]

Yep used all of your code and it still throws me the error

 

[DanteAmor]

Run the macro again, when the error occurs, bring the mouse closer to the sourceWSname variable to see the content, make sure that the image also shows the sheet with the name that the variable says.

 

[juscuz419]

Hovering the mouse reveals
sourceWSname = " "

sourceWS = Nothing

in the statement that bombs. There are four WS currently in the WB that have the names SXC_4698A, JCP_4698D, MRC_4699A, and FAC_4699D. The sheets are there just not getting to any with the code.

 

[DanteAmor]

If it is "" then the msgbox should appear. Did you modify my code?

 

[juscuz419]

Here is the entire code I am using. Your code is at the top followed by the code below the double line that does work for the copy and paste. Interestingly, if I comment out the Next WS line at the bottom of the code (as shown below) I get the first timesheet read and the values pasted correctly but it does not get to the next WS. If I comment out the Next WS in your code at the top, I get the MsgBox "there is no sheet with that pattern". Really got me scratching my head.

Sub CopyValuesBetweenWorksheets()

Dim sourceWS As Worksheet
Dim targetWS As Worksheet
Dim ws As Worksheet
Dim WSName As String
Dim wsDailySummary As Worksheet
Dim sourceWSName As String

For Each ws In ThisWorkbook.Worksheets
If ws.Name Like "???_?????" Then
sourceWSName = ws.Name
Exit For
End If
Next ws

If sourceWSName = "" Then
MsgBox "There is no sheet with that pattern."
Else
Set sourceWS = ThisWorkbook.Worksheets(sourceWSName)
Set targetWS = ThisWorkbook.Worksheets("Daily Summary")
End If

Set sourceWS = ThisWorkbook.Worksheets(sourceWSName)
----------------------------------------------------------------------------------------
' Check the date entered on the Daily Summary against the date on the first row of the timesheets for a match
Dim datevalueDailySummary As Date
Dim datevaluesourcews As Date

' Set references to the worksheets
Set wsDailySummary = ThisWorkbook.Worksheets("Daily Summary")
'Set sourceWS = ThisWorkbook.Worksheets(sourceWSName)
Set targetWS = ThisWorkbook.Worksheets("Daily Summary")

' Get the dates from the specified cells
datevalueDailySummary = wsDailySummary.Range("N14").Value
datevaluesourcews = sourceWS.Range("C18").Value

' Compare the dates
If datevalueDailySummary = datevaluesourcews Then
' Fill in the first row on the Daily Summary Sheet
' Copy values from specific cells in the source sheet to specific cells in the target sheet

targetWS.Range("B21").Value = sourceWS.Range("f4").Value
targetWS.Range("c21").Value = sourceWS.Range("m4").Value
targetWS.Range("d21").Value = sourceWS.Range("q1").Value

Dim lastRow As Long
Dim i As Long

' Find the last row with data in the source worksheet
lastRow = 32 'sourcews.Cells(sourcews.Rows.Count, "C").End(xlUp).Row

' Loop through each row in the source worksheet

For i = 18 To lastRow

' Check if the date value in column C matches datevalueDailySummary
If sourceWS.Cells(i, 3).Value = datevalueDailySummary Then
' Copy relevant data to the next available row in the target worksheet
targetWS.Cells(targetWS.Rows.Count, "F").End(xlUp).Offset(1, 0).Value = sourceWS.Cells(i, 5).Value
targetWS.Cells(targetWS.Rows.Count, "G").End(xlUp).Offset(1, 0).Value = sourceWS.Cells(i, 6).Value
targetWS.Cells(targetWS.Rows.Count, "H").End(xlUp).Offset(1, 0).Value = sourceWS.Cells(i, 7).Value
targetWS.Cells(targetWS.Rows.Count, "I").End(xlUp).Offset(1, 0).Value = sourceWS.Cells(i, 8).Value

' Check other conditions and update targetws.Range("E") accordingly
If sourceWS.Range("AD3").Value Or sourceWS.Range("AD4").Value = True Then
targetWS.Cells(targetWS.Rows.Count, "E").End(xlUp).Offset(1, 0).Value = "Pickup/SUV"
End If

targetWS.Cells(targetWS.Rows.Count, "K").End(xlUp).Offset(1, 0).Value = sourceWS.Cells(i, 21).Value
targetWS.Cells(targetWS.Rows.Count, "L").End(xlUp).Offset(1, 0).Value = sourceWS.Cells(i, 22).Value
End If
Next i
End If
'Next ws
End Sub[/CODE]

 

[DanteAmor]

There are four WS currently in the WB that have the names SXC_4698A, JCP_4698D, MRC_4699A, and FAC_4699D.

Do they really have that name?
Check if they have any blank spaces before or after the name.
Do all four sheets have the underscore in the fourth position?