Problem looping through worksheet

[Diving_Dan]

Hi all,

I'm having an issue trying to loop a macro through all worksheets in a workbook. The code worked if I run the macro on an individual sheet but when I added in the loop it only takes the data from the active sheet. Below is some of my code, I've removed quite a bit of it for copying values as that isn't needed.

I'm guessing the problem is going to be where I set "sh" as the activesheet. I hoped that because I started the loop before i set the activesheet I wouldn't have a problem but I am. I run the code and I only get data transferred from the activesheet that I'm on at the time I run the macro.

Any help is appreciated as always.

Dim sDate As Date
Dim sh As Worksheet                 'original sheet
Dim wb As Workbook                  'destination
Dim f As Range
 
    For Each Worksheet In Worksheets
    
    Set sh = ThisWorkbook.ActiveSheet   'original book original sheet
    sDate = sh.Range("C3").Value
    
    Set wb = Workbooks.Open("C\Master.xlsx")
    
    wb.Sheets("Data").Unprotect Password:="abcde"
    Set f = wb.Sheets("Data").Range("A:A").Find(sDate, , xlFormulas, xlWhole)
    
    If Not f Is Nothing Then
    f.Offset(, 1).Value = sh.Range("C6").Value
   
   
   wb.Sheets("Data").Protect Password:="abcde"
    wb.Close True
  Else
    MsgBox "Date does not exist"
    wb.Close False
  End If
  
  Next

  Application.ScreenUpdating = True
  
  MsgBox "Transfer to master sheet complete"

 

[Darren Bartrup]

You written For Each Worksheet In Worksheets.
You've defined sh as a Worksheet so it should be For Each sh In Worksheets. You can then remove Set sh = ThisWorkbook.ActiveSheet as sh is defined in the loop.

You then open Master.xlsx on each iteration of the loop - better to open it once before the loop starts and close it after all sheets have been looked at?

I think your code should look more like:

Sub Test()

    Dim sDate As Date
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim f As Range
    
    Set wb = Workbooks.Open("C\Master.xlsx") 'Check your path... 'C:\Master.xlsx'?
    wb.Sheets("Data").Unprotect Password:="abcde"
    
    For Each sh In ThisWorkbook.Worksheets 'ThisWorkbook is the file containing this code.
        sDate = sh.Range("C3").Value
        Set f = wb.Sheets("Data").Range("A:A").Find(sDate, , xlFormulas, xlWhole)
        
        If Not f Is Nothing Then
            f.Offset(, 1).Value = sh.Range("C6").Value
        Else
            'This may pop up multiple times during execution.
            'Maybe create a list of sheets where the date is not found
            'and mention them in a single message at the end.
            MsgBox "Date does not exist in " & sh.Name, vbCritical + vbOKOnly
        End If
    Next sh
    
    wb.Sheets("Data").Protect Password:="abcde"
    wb.Close True

End Sub

 

[Diving_Dan]

Thanks for that it does exactly what I want. I think I was getting a bit too tired last night. I did try moving the open master to outside of the loop but I couldn't get any of it to work so came to here in the end. But now it is perfect so thanks.

I like your idea about creating a list of sheets where the date is not found. How would you suggest doing that? get rid of that message box, put the name of the worksheet where the date isn't found on a separate sheet and then reference those cell ranges within a messagebox at the end?

 

[Darren Bartrup]

No need to refer to sheets more often than needed.

Create an string variable to store the sheet names separated by a line break to replace the message box:

shtNames = shtNames & sh.Name & Chr(10)

Then outside the loop check if the variable holds any values and display the message if it does:

    If shtNames <> "" Then
        MsgBox "Date does not exist in " & Chr(10) & shtNames, vbCritical + vbOKOnly
    End If

 

[Diving_Dan]

Thanks Darren, works perfectly