Excel VBA .Find issue

[chrisnash]

Hello I have a workbook, that has multiple sheets the sheets are called the following Supervisors 1 , Supervisors 2, Supervisors 3, Supervisors 4, Staff 1, Staff 2, Staff 3, Staff 4 and a sheet called Summary.

My issue is that when I try to look for Total Supervisors or Total Staff, I get a 'Error code 91 , variable not set'

I am still new to vba and people on here have been so supportive and helpful sO can I ask again for all your help and advice.

Private Sub Worksheet_Activate()Dim r As Range, rc As Range, rd As Range, rng As Range, rngC As Range, rndD As Range, snRow As Range, TmRow As Range, snRowC As Range
Dim x As Integer, xc As Integer, xd As Integer, ETRow As Long, LTRow As Long, NTRow As Long, ETRowC As Long, LTRowC As Long
Dim TMName As String, TMNameC As String


Application.ScreenUpdating = False
ETRow = 10: LTRow = 10: NTRow = 10
ETRowC = 10: LTRowC = 10


ActiveSheet.Range("C4:AG9").ClearContents
For x = 1 To Sheets.Count
For xc = 1 To Sheets.Count


    If Sheets(x).Name <> "Summary" Then
        TMName = Left(Sheets(x).Name, 6)
        Set snRow = Sheets(Sheets(x).Name).Range("C:C").Find("Total Supervisors", LookIn:=xlValues, LookAt:=xlWhole)
      
        Set rng = Sheets(Sheets(x).Name).Range("D5", "AH5")
        For Each r In rng
            If InStr(1, r.Value, "ET") > 0 Then
                Sheets("Summary").Cells(4, r.Column - 1) = Sheets(Sheets(x).Name).Cells(snRow.Row, r.Column).Value
                ETRow = ETRow + 1
                
            ElseIf InStr(1, r.Value, "LT") > 0 Then
                Sheets("Summary").Cells(5, r.Column - 1) = Sheets(Sheets(x).Name).Cells(snRow.Row, r.Column).Value
                LTRow = LTRow + 1
                
                ElseIf InStr(1, r.Value, "NT") > 0 Then
                Sheets("Summary").Cells(6, r.Column - 1) = Sheets(Sheets(x).Name).Cells(snRow.Row, r.Column).Value
                NTRow = NTRow + 1
                
       
            ElseIf Sheets(xc).Name <> "Summary" Then
            TMNameC = Left(Sheets(xc).Name, 6)
            Set snRowC = Sheets(Sheets(xc).Name).Range("C:C").Find("Total Cleaners", LookIn:=xlValues, LookAt:=xlWhole)
            Set rngC = Sheets(Sheets(xc).Name).Range("D5", "AH5")
            For Each rc In rngC
                If InStr(1, rc.Value, "ET") > 0 Then
                Sheets("Summary").Cells(8, rc.Column - 1) = Sheets(Sheets(xc).Name).Cells(snRowC.Row, rc.Column).Value
                ETRowC = ETRowC + 1
            
            ElseIf InStr(1, rc.Value, "LT") > 0 Then
            Sheets("Summary").Cells(9, rc.Column - 1) = Sheets(Sheets(xc).Name).Cells(snRowC.Row, rc.Column).Value
            LTRowC = LTRowC + 1
        
End If
Next


End If
Next


End If
Next
Next




Application.ScreenUpdating = True
End Sub

 

[baitmaster]

Difficult to say exactly what's going wrong, but a couple of observations and a few code amendments for you

Option Explicit

Private Sub Worksheet_Activate()

Dim r As Range, rc As Range, rd As Range, rng As Range, rngC As Range, rndD As Range, snRow As Range, TmRow As Range, snRowC As Range
Dim xc As Integer, xd As Integer, ETRow As Long, LTRow As Long, NTRow As Long, ETRowC As Long, LTRowC As Long
Dim TMName As String, TMNameC As String

'Application.ScreenUpdating = False
ETRow = 10: LTRow = 10: NTRow = 10
ETRowC = 10: LTRowC = 10

ActiveSheet.Range("C4:AG9").ClearContents

Dim ws As Worksheet
For Each ws In Sheets
    For xc = 1 To Sheets.Count
        If ws.Name <> "Summary" Then
            
            TMName = Left(ws.Name, 6)
            Set snRow = ws.Range("C:C").Find("Total Supervisors", LookIn:=xlValues, LookAt:=xlWhole)
            Set rng = ws.Range("D5", "AH5")
            
            For Each r In rng
                If InStr(1, r.Value, "ET") > 0 Then
                    Sheets("Summary").Cells(4, r.Column - 1) = ws.Cells(snRow.Row, r.Column).Value
                    ETRow = ETRow + 1
                    
                ElseIf InStr(1, r.Value, "LT") > 0 Then
                    Sheets("Summary").Cells(5, r.Column - 1) = ws.Cells(snRow.Row, r.Column).Value
                    LTRow = LTRow + 1
                    
                ElseIf InStr(1, r.Value, "NT") > 0 Then
                    Sheets("Summary").Cells(6, r.Column - 1) = ws.Cells(snRow.Row, r.Column).Value
                    NTRow = NTRow + 1
                    
                ElseIf Sheets(xc).Name <> "Summary" Then
                    TMNameC = Left(Sheets(xc).Name, 6)
                    Set snRowC = Sheets(Sheets(xc).Name).Range("C:C").Find("Total Cleaners", LookIn:=xlValues, LookAt:=xlWhole)
                    Set rngC = Sheets(Sheets(xc).Name).Range("D5", "AH5")
            
                    For Each rc In rngC
                        If InStr(1, rc.Value, "ET") > 0 Then
                            Sheets("Summary").Cells(8, rc.Column - 1) = Sheets(Sheets(xc).Name).Cells(snRowC.Row, rc.Column).Value
                            ETRowC = ETRowC + 1
                            
                        ElseIf InStr(1, rc.Value, "LT") > 0 Then
                            Sheets("Summary").Cells(9, rc.Column - 1) = Sheets(Sheets(xc).Name).Cells(snRowC.Row, rc.Column).Value
                            LTRowC = LTRowC + 1
                            
                        End If
                    
                    Next rc
                End If
            Next r
        End If
    Next xc
Next ws

'Application.ScreenUpdating = True
End Sub

I've switched off your screenupdating rows. Get the code running right before worrying about getting it running pretty, this line won't help you to debug your code. Switched off you might get a better feel for what's happening

You're running through the worksheets by number, but you can run through them by actual worksheet. I've created a ws object so you look at each worksheet directly. I haven't done this for the second sheet loop (why are there 2, I didn't work that out yet?) but you should see that the code is slightly simplified by the approach and this may help you to read it and spot problems easier

I've tweaked your indentation, and your Next statements just to help clarify the structure. Sorry, I'm a little OCD with things like that

I note this is a "worksheet_activate" event that then refers to other worksheets. You may experience issues due to where the code is located, as code in one worksheet module can't easily refer to other worksheets. You may need to qualify "sheets" better, e.g. thisworkbook.sheets, to help your code see the other sheets. Alternatively, try moving the majority of code to a general code module and just call it from the event

You haven't stated which row you encounter problems on. I assume it's the Find row, what happens at this point? Consider:
- which ws is your code looking at?
- does that ws contain the required search term in column C?
To help you, use either the Immediate window or the Watch window in the VB Editor. Whilst in Break mode (yellow row highlighted in VB) type the following in Immediate: ?ws.name and hit enter

 

[chrisnash]

Hello it always refers to

 Sheets("Summary").Cells(9, rc.Column - 1) = Sheets(Sheets(xc).Name).Cells(snRowC.Row, rc.Column).Value

but this can go from ET to Lt to NT but it always highlight these lines of code.

I will run you code and get back to you, but thank you for your help so far.

 

[chrisnash]

Still showing the same error

 

[baitmaster]

I expect it to as we haven't done anything to correct an actual error yet. I need you to look at the questions I've asked in the last section, we need to do a little debugging to work out the cause of the problem, then we can account for it

Also, after "For xc = 1 To Sheets.Count" add a new row "debug.print ws.name, xc". This will write the values of these 2 variables into the Immediate window each time the row is encountered, so we can find which loop the error occurs on

 

[chrisnash]

I expect it to as we haven't done anything to correct an actual error yet. I need you to look at the questions I've asked in the last section, we need to do a little debugging to work out the cause of the problem, then we can account for it

Also, after "For xc = 1 To Sheets.Count" add a new row "debug.print ws.name, xc". This will write the values of these 2 variables into the Immediate window each time the row is encountered, so we can find which loop the error occurs on

So each sheet looks like this (apart from the Summary sheet,), the drop down boxes show et lt or nt next to the day which is selected by the manager who does the rostering, for example 1 ET 2 ET then if there is a W in the box which corresponds with the date a staff member it mean they are working that day on a early shift.

On all sheets the dates are from CELLS D5 TO AH5

Leave blank for normal Rest Days											Staff TEAM 4
YEAR		MONTH	KEY
2018		MARCH	W	WORK	T	TRAINING
Staff NO.	Grade	Name	1 ET (Cell D5)	2 ET (Cell E5)	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26	27	28	29	30	31 (Cell AH5)
1234			W	T
5678			T	W
			W	T
		Total Training	1	2	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0
		Total Staff	2	1	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0
		Total Sick	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0

<tbody>
</tbody>

So ws looks at all the worksheets in the workbook except the Summary sheet and finds all sheets that has ET, LT or NT next to the date and then it looks for Total Supervisors or Total Staff and then add the number for each day on to the Summary Sheet.

Column C is where the summary sheet starts on the 1st

Supervisors

Column C

1st

2nd

3rd

4th

5th

6th

7th

8th

9th

10th

11th

12th

13th

14th

15th

16th

17th

18th

19th

20th

21st

22nd

23rd

24th

25th

26th

27th

28th

29th

30th

31st

ET

2

1

LT

NT

Staff

ET

LT

<tbody>
</tbody>

The immediate window shows this now.

Supervisor - Team 1 1
Supervisor - Team 1 2
Supervisor - Team 1 3
Supervisor - Team 1 4
Supervisor - Team 1 5



Thank you once again for all you help on this.

 

[chrisnash]

Just for you infomration when I comment out part of the original code to exclude the staff it will work without an issue but as soon as I include the staff aspect to it it throws the error code up.

Option Explicit

Private Sub Worksheet_Activate()
Dim r As Range, rc As Range, rd As Range, rng As Range, rngC As Range, snRow As Range, TmRow As Range, snRowC As Range
Dim x As Integer, xc As Integer, ETRow As Long, LTRow As Long, NTRow As Long, ETRowC As Long, LTRowC As Long
Dim TMName As String, TMNameC As String




Application.ScreenUpdating = False
ETRow = 10: LTRow = 10: NTRow = 10
ETRowC = 10: LTRowC = 10




ActiveSheet.Range("C4:AG9").ClearContents
For x = 1 To Sheets.Count






    If Sheets(x).Name <> "Summary" Then
        TMName = Left(Sheets(x).Name, 6)
        Set snRow = Sheets(x).Range("C:C").Find("Total GPD", LookIn:=xlValues, LookAt:=xlWhole)
        
         If Not snRow Is Nothing Then
      
        Set rng = Sheets(Sheets(x).Name).Range("D5", "AH5")
        For Each r In rng
            If InStr(1, r.Value, "ET") > 0 Then
                Sheets("Summary").Cells(4, r.Column - 1) = Sheets(Sheets(x).Name).Cells(snRow.Row, r.Column).Value
                ETRow = ETRow + 1
                
            ElseIf InStr(1, r.Value, "LT") > 0 Then
                Sheets("Summary").Cells(5, r.Column - 1) = Sheets(Sheets(x).Name).Cells(snRow.Row, r.Column).Value
                LTRow = LTRow + 1
                
                ElseIf InStr(1, r.Value, "NT") > 0 Then
                Sheets("Summary").Cells(6, r.Column - 1) = Sheets(Sheets(x).Name).Cells(snRow.Row, r.Column).Value
                NTRow = NTRow + 1
                
       
'            ElseIf Sheets(x).Name <> "Summary" Then
'            TMNameC = Left(Sheets(x).Name, 6)
'            Set snRowC = Sheets(Sheets(x).Name).Range("C:C").Find("Total ESD", LookIn:=xlValues, LookAt:=xlWhole)
'            Set rngC = Sheets(Sheets(x).Name).Range("D5", "AH5")
'            For Each rc In rngC
'                If InStr(1, rc.Value, "ET") > 0 Then
'                Sheets("Summary").Cells(8, rc.Column - 1) = Sheets(Sheets(x).Name).Cells(snRowC.Row, rc.Column).Value
'                ETRowC = ETRowC + 1
'
'            ElseIf InStr(1, rc.Value, "LT") > 0 Then
'            Sheets("Summary").Cells(9, rc.Column - 1) = Sheets(Sheets(x).Name).Cells(snRowC.Row, rc.Column).Value
'            LTRowC = LTRowC + 1
        
'End If
'Next




End If
Next
End If


End If
Next










Application.ScreenUpdating = True
End Sub

 

[baitmaster]

OK so we can establish that your code is failing on the 5th xc loop that it looks at worksheet "Supervisor - Team 1"

Perhaps its breaking on a different row then? Can you confirm which row is highlighted in yellow if you enter debug mode?

Also, amend your debug line to "debug.print ws.name, xc, sheets(xc).name" and rerun

How many worksheets does your workbook have?

 

[baitmaster]

Just for you infomration when I comment out part of the original code to exclude the staff it will work without an issue but as soon as I include the staff aspect to it it throws the error code up.

This does not surprise me. You are successfully finding something for a few iterations but then failing later (i.e. the 5th loop in the case you reported). Something about the worksheet (xc = 5) is failing to find the value you're looking for. Perhaps it's aligned differently, or has a different spelling of the search term. We may need to check spellings, check which range we are searching in / or rearrange the columns slightly, or maybe completely change the approach such as by introducing named ranges

 

[Fluff]

Cross post https://www.excelforum.com/excel-programming-vba-macros/1221221-excel-vba-find-issue.html

Cross-Posting
While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.