The correct row is not being highlighted and having appropriate code run on that row

[dpaton05]

This is a strange error as it happens to me sometimes, but not every time. There are two procedures that both are used to identify a row and do something to it. They are called Transfer and LateCancel. They both are meant to cycle through each row, highlighting one row at a time and ask "is this the row?" When the user selects Yes it does something to the row and exits the sub. If No is selected, the highlighting is removed from that row and the next row is highlighted, asking the same question. The subs are initiated from a totals sheet where there 2 spots to enter a date and a request number in some cells. One spot for the Transfer sub to run and one spot for the LateCancel.



The transfer sub is not self explanatory from it's name. This is run on jobs that are to be cancelled.

Order of events

1. I run the sub Transfer from the totals sheet through a command button
2. Row 4 in the July sheet is highlighted
3. I am asked the question, "Is this the job you want to cancel?"
4. I press No and the highlighting moves to row 5 and asks the same question.
5. I press Yes on this row and the row is moved to the cancellations sheet and the sub is exited
6. I run the sub again from the totals sheet
7. Row 4 in the July sheet is highlighted
8. I am asked the question, "Is this the job you want to cancel?"
9. I press No and the highlighting moves to row 5 and asks the same question.
10. I press Yes on this row and the row is moved to the cancellations sheet and the sub is exited
    1. This is exactly what I want it to do so far
11. I now go back to the totals sheet and run the LateCancel sub
12. There is one row left in the July sheet that matches the filters of the autofilter so I would expect that row to be highlighted
13. The header row is highlighted next, where it should have highlighted the remaining row that matches the autofilter. It also asks me the above question.
14. If I keep pressing No, the row is highlighted agan after each time and asked the same question
15. If I press Yes, I get the error message that "No jobs have been selected as a late cancel"
16. I run the LateCancel sub again from the totals sheet and it repeats the steps from step 12

1. I know that this is a sometimes error as if I re-open my file and run the LateCancel sub first, the 3 jobs are cycled though as expected, and I am asked the question each time.
2. If I press Yes or No, it does what it's meant to do

I have been doing some testing and this is the totals sheet, where the information is entered. I leave it the same each time and just run the subs.

CSS Work Allocation Sheet.77.xlsm
	B	C	D	E	F	G
22	Cancelling a job
23	To cancel a job, enter the request number in B25 followed by the date of the proposed job in B27 then press enter and select the cancel the Cancel a job button.
24	Request number
25	95
26	Date
27	5/07/2021
28
29	Late Cancel
30	To enter a job as a late cancel, enter a request number first in B32, followed by the date of the proposed job in B37 then press enter and select the Add Late Cancel button.
31	Request number
32	95
33	Everytime you leave this sheet and return, this will be 3
34	Hours charged for a late cancel
35	3
36	Date
37	5/07/2021
Totals

Cells with Data Validation
Cell	Allow	Criteria
B27	Any value
B25	Any value

I have been testing on the one date 5/07/2021 and here is a monthly sheet in the same document as the above sheet where the data is held.

CSS Work Allocation Sheet.77.xlsm
	A	B	C	D	E	F	G	H	I	J
1	501 CSS July
2
3	Date	Purchase order #	Req #	Name	Service	Requesting Organisation	Caseworker Name	Price ex. GST	GST	Price inc. GST
4	5/07/2021		95		Tutoring			$2.00
5	5/07/2021		95	asdf	Supervised Contact			$219.30	$21.93	$241.23
6	5/07/2021		95	asdf	Supervised contact			$219.30	$21.93	$241.23
July

Cell Formulas
Range	Formula
I5	I5	=IF(E5="Activities",0,H5*0.1)
J5	J5	=I5+H5

Cells with Data Validation
Cell	Allow	Criteria
F6:J6	Any value

This is my Transfer sub

Sub Transfer()
        Dim ws As Worksheet, sh As Worksheet, sht As Worksheet, AutoFilterCounter As Long
        Set sh = Sheets("Totals")
        Set sht = Sheets("Cancellations")
        Dim Req As String: Req = sh.[B25].Value
        Dim Dt As String: Dt = sh.[B27].Value
        Dim SheetCounter As Integer: SheetCounter = 0
'Call TurnOffFunctionality
        
        For Each ws In Worksheets
                If ws.Name <> "Cancellations" And ws.Name <> "Totals" And ws.Name <> "Sheet2" Then
                        With ws.[A3].CurrentRegion
                                .AutoFilter 1, Dt           ' autofilter for the value in cell [B27]
                                .AutoFilter 3, Req          ' autofilter for the value in cell [B25]
                                                                    'Check to see if the date cell, column A, for a job has anything in it. If it doesn't, turn the autofilter off and skip to the next sheet.
                                    If ws.[A3].Cells.Offset(1, 0) = "" Then
                                        .AutoFilter
                                        SheetCounter = SheetCounter + 1
                                        'If SheetCounter = 12, none of the 12 monthly sheets have the entered date and request number so let the user know
                                        If SheetCounter = 12 Then
                                            MsgBox "A job with the date and request number entered does not exist"
                                        End If
                                        GoTo SkipSheet
                                    End If
                                    
                                'Check the count Autofilter
                                AutoFilterCounter = .Columns(1).SpecialCells(xlCellTypeVisible).Count
                                'If value less than 2, only the heading is visible so skip to the next sheet.
                                If AutoFilterCounter < 2 Then
                                    .AutoFilter
                                    'Add 1 to a sheet counter
                                    SheetCounter = SheetCounter + 1
                                    'If SheetCounter = 12, none of the 12 monthly sheets have the entered date and request number so let the user know
                                    If SheetCounter = 12 Then
                                        MsgBox "A job with the date and request number entered does not exist"
                                    End If
                                    GoTo SkipSheet
                                End If
                                
                                Dim LastRow As Long
                                LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
                                Dim rng As Range: Set rng = ws.Range("A4:A" & LastRow)
                                
                                Dim rws&: rws = Range("A4:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeVisible).Count
                                'if this range is greater than 1, ask the below question, else continue
                                If rws > 1 Then
                                'If ws.Range("A4", ws.Range("A4").End(xlDown)) > 1 Then
                                    Dim answer As Integer, n As Integer
                                    Dim RowNumber As Long
                                    Dim RowLine As Range
                                    Application.ScreenUpdating = True
                                    n = 0
                                    For Each RowLine In rng.SpecialCells(xlCellTypeVisible)
                                        ws.Activate
                                        RowLine.EntireRow.Interior.ColorIndex = 6
                                        answer = MsgBox("Is this the job you want to cancel?", vbQuestion + vbYesNo + vbDefaultButton2, "Cancel Job")
                                        RowLine.EntireRow.Interior.ColorIndex = 0
                                        If answer = vbYes Then
                                            'Copy and paste the selected row
                                            RowLine.EntireRow.Copy sht.Range("A" & Rows.Count).End(xlUp).Offset(1)
                                            RowLine.EntireRow.Delete
                                            'I had to include a -3 in here to account for the 3 rows above the data that don't have data in them
                                            'RowNumber = RowLine.Row - 3
                                            GoTo FoundRightJob
                                        End If
                                        If answer = vbNo Then n = n + 1
                                    Next RowLine
                                If n > 0 Then MsgBox " You have chosen not to cancel any of the " & n & " job/s !!"
                                End If
                                
FoundRightJob:

                                .AutoFilter                 ' turn off the autofilter
                        End With
                End If
SkipSheet:
        Next ws


'sh.Range("B25,B27").ClearContents
'Call TurnOnFunctionality
End Sub

This is my LateCancel sub

Sub LateCancel()
        Dim ws As Worksheet, sh As Worksheet, sht As Worksheet, QT As String, wb2 As Workbook, WbPath As String, QTPath As String
        Dim Serv As String, Month As String, Service As String, LCPrice As String, AutoFilterCounter As Long
        Set wb2 = ThisWorkbook
        'QT = "CSS_quoting_tool_29.5.xlsm"
        Set sh = wb2.Worksheets("Totals")

        'values on totals sheet that the user is looking for
        Dim LCReq As String: LCReq = sh.Cells(32, 2).Value
        'Dim LCDt As String: LCDt = sh.Cells(37, 2).Value
        Dim LCDt As String: LCDt = CDate(sh.Cells(37, 2).Value)
        Dim LateCancelHours As String: LateCancelHours = sh.Cells(35, 2).Value
        Dim SheetCounter As Long: SheetCounter = 0
        
        WbPath = ThisWorkbook.Path
        QTPath = ThisWorkbook.Path & "\..\" & "\..\"
'Call TurnOffFunctionality
        'If Not isFileOpen(DocYearName & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Work Allocation Sheets" & "\" & Site & "\" & DocYearName & ".xlsm"
        'If Not isFileOpen(QT) Then Workbooks.Open QTPath & "\" & QT
    
        For Each ws In wb2.Worksheets
                If ws.Name <> "Cancellations" And ws.Name <> "Totals" And ws.Name <> "Sheet2" Then
                        With ws.[A3].CurrentRegion
                                'On Error Resume Next
                                'Autofilter the late cancel date enter in B37 with dates in column 1
                                .AutoFilter 1, LCDt
                                'Autofilter the late cancel request number with request numbers in column 3
                                .AutoFilter 3, LCReq
                                
                                'Check to see if the date cell, column A, for a job has anything in it. If it doesn't, turn the autofilter off and skip to the next sheet.
                                If ws.[A3].Cells.Offset(1, 0) = "" Then
                                    .AutoFilter
                                    SheetCounter = SheetCounter + 1
                                    'If SheetCounter = 12, none of the 12 monthly sheets have the entered date and request number so let the user know
                                    If SheetCounter = 12 Then
                                        MsgBox "A job with the date and request number entered does not exist"
                                    End If
                                    GoTo SkipNextSheet
                                End If
                                
                                'Check the count Autofilter
                                AutoFilterCounter = .Columns(1).SpecialCells(xlCellTypeVisible).Count
                                'If value less than 2, only the heading is visible so skip to the next sheet.
                                If AutoFilterCounter < 2 Then
                                    .AutoFilter
                                    'Add 1 to a sheet counter
                                    SheetCounter = SheetCounter + 1
                                    'If SheetCounter = 12, none of the 12 monthly sheets have the entered date and request number so let the user know
                                    If SheetCounter = 12 Then
                                        MsgBox "A job with the date and request number entered does not exist"
                                    End If
                                    GoTo SkipNextSheet
                                End If
                                
                                    With Application.Intersect(.SpecialCells(xlCellTypeVisible), .Offset(1, 0))
                                        'Check if there is a service entered in column 5 of the filtered job.
                                        
                                        If .Areas(1).Cells(1, 5).Value = "" Then
                                            'Display a messagebox with a message and the sheet that has the missing service.
                                            MsgBox "There is a job in the " & ws.Name & " sheet that matches the date and request number but does not have a " & _
                                            "service type. Please add a service type to this job before continuing."
                                            Call TurnOnFunctionality
                                            .AutoFilter
                                            'Cells(32, 2).ClearContents
                                            'Cells(37, 2).ClearContents
                                            Exit Sub
                                        End If
                                        'If the service column, (5), has a value, store the service in the service variable.
                                        Service = .Areas(1).Cells(1, 5).Value
                                    End With
                                
                                Dim LastRow As Long
                                LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
                                Dim rng As Range: Set rng = ws.Range("A4:A" & LastRow)
                                
                                Dim rws&: rws = Range("A4:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeVisible).Count
                                'if this range is greater than 1, ask the below question, else continue
                                If rws > 1 Then
                                'If ws.Range("A4", ws.Range("A4").End(xlDown)) > 1 Then
                                    Dim answer As Integer
                                    Dim RowNumber As Long
                                    Dim RowLine As Range
                                    Application.ScreenUpdating = True
                                    For Each RowLine In rng.SpecialCells(xlCellTypeVisible)
                                        ws.Activate
                                        RowLine.EntireRow.Interior.ColorIndex = 6
                                        answer = MsgBox("Is this the job you want to apply the late cancel price too?", vbQuestion + vbYesNo + vbDefaultButton2, "Late Cancel Price")
                                        RowLine.EntireRow.Interior.ColorIndex = 0
                                        If answer = vbYes Then
                                            'I had to include a -3 in here to account for the 3 rows above the data that don't have data in them
                                            RowNumber = RowLine.Row - 3
                                            GoTo FoundRightJob
                                        End If
                                        'If answer = vbNo
                                        
                                    Next RowLine
                                End If
FoundRightJob:
                                'No has been selected each time so display a message box and exit sub
                                If RowNumber < 1 Then
                                    MsgBox "No jobs have been selected as a Late Cancel"
                                    .AutoFilter
                                    Exit Sub
                                End If
                                    'Copy data fom the job back to a calculator on the data sheet (this is the code name for sheet2) to calulcate the price again.
                                    With Data
                                        .Cells(30, 1) = CDate(LCDt)
                                        '.Cells(30, 1) = Format(Date, "d/mm/yyyy")
                                        '.Cells(30, 1).NumberFormat = "d/mm/yyyy"
                                        .Cells(30, 2) = Service
                                        'Set the hourly figure in the lateCanel table to be the LateCancelHours variable
                                        .Cells(30, 5) = LateCancelHours
                                        'A late cancel will be charged for 1 staff member attending
                                        'Therefore, set the Staff Req. figure to 1
                                        .Cells(30, 6) = 1
                                    End With
                                    On Error GoTo Price
                                        'Calculates price of late cancel on worksheet so the new price will be copied to the allocation sheet instead of the previous price
                                        Calculate
                                    LCPrice = Data.Cells(30, 8).Value
Price:
                                Select Case Err.Number
                                    Case Is = 13
                                        MsgBox "There is a problem with the spelling of the service type on the " & ws.Name & " sheet for the job that matches " _
                                        & "the date and request number. Please check the spelling and try again."
                                        'Cells(32, 2).ClearContents
                                        'Cells(37, 2).ClearContents
                                        .AutoFilter
                                        Call TurnOnFunctionality
                                        Exit Sub
                                End Select
                                On Error GoTo 0
                                With Application.Intersect(.SpecialCells(xlCellTypeVisible), .Offset(1, 0))
                                    Dim LTCnclDate As String
                                    .Areas(1).Cells(RowNumber, 1).Value = "LT CNCL " & .Areas(1).Cells(1, 1).Value
                                    .Areas(1).Cells(RowNumber, 8).Value = LCPrice
                                    .Areas(1).Cells(RowNumber, 9).Formula = "=IF(RC[-4]=""Activities"",0,RC[-1]*0.1)"
                                    .Areas(1).Cells(RowNumber, 10).Formula = "=RC[-1]+RC[-2]"
                                End With
                                .AutoFilter
                        End With
                End If
SkipNextSheet:
        Next ws
'sh.Range("B32,B37").ClearContents
'Call TurnOnFunctionality
End Sub

Can someone help me work out why this occurs sometimes and not other times please?

 

[dpaton05]

This is what is happening now.

This is my spreadsheet before any changes

CSS Work Allocation Sheet.83-1.xlsm
	A	B	C	D	E	F	G	H	I	J
3	Date	Purchase order #	Req #	Name	Service	Requesting Organisation	CW	Price ex. GST	GST	Price inc. GST
4	5/07/2021		95	one	Supervised contact
5	5/07/2021		95	two	Supervised Contact
6	5/07/2021		95	three	Supervised Contact
7	5/07/2021		95	four	Supervised Contact
8	7/01/1900		58
9	8/01/1900		59
10	9/01/1900		60
11	10/01/1900		61
12	11/01/1900		62
13	12/01/1900		63
July

Cells with Data Validation
Cell	Allow	Criteria
F4:J4	Any value

I run the sub for the first time and press No then Yes and get this result. Notice how the correct line had the changes applied to it.

CSS Work Allocation Sheet.83-1.xlsm
	A	B	C	D	E	F	G	H	I	J
3	Date	Purchase order #	Req #	Name	Service	Requesting Organisation	CW	Price ex. GST	GST	Price inc. GST
4	5/07/2021		95	one	Supervised contact
5	5/07/2021		95	two	Supervised Contact
6	LT CNCL 5/07/2021		95	three	Supervised Contact			$219.30	$21.93	$241.23
7	5/07/2021		95	four	Supervised Contact
8	7/01/1900		58
9	8/01/1900		59
10	9/01/1900		60
11	10/01/1900		61
12	11/01/1900		62
13	12/01/1900		63
July

Cell Formulas
Range	Formula
I6	I6	=IF(E6="Activities",0,H6*0.1)
J6	J6	=I6+H6

Cells with Data Validation
Cell	Allow	Criteria
F4:J4	Any value

The second time I run the sub, I press No then Yes and get this result. Notice how the correct line had the changes applied to it too.

CSS Work Allocation Sheet.83-1.xlsm
	A	B	C	D	E	F	G	H	I	J
3	Date	Purchase order #	Req #	Name	Service	Requesting Organisation	CW	Price ex. GST	GST	Price inc. GST
4	5/07/2021		95	one	Supervised contact
5	LT CNCL 5/07/2021		95	two	Supervised Contact			$219.30	$21.93	$241.23
6	LT CNCL 5/07/2021		95	three	Supervised Contact			$219.30	$21.93	$241.23
7	5/07/2021		95	four	Supervised Contact
8	7/01/1900		58
9	8/01/1900		59
10	9/01/1900		60
11	10/01/1900		61
12	11/01/1900		62
13	12/01/1900		63
July

Cell Formulas
Range	Formula
I5:I6	I5	=IF(E5="Activities",0,H5*0.1)
J5:J6	J5	=I5+H5

The third time I run the sub, I press No then Yes and get this result.

CSS Work Allocation Sheet.83-1.xlsm
	A	B	C	D	E	F	G	H	I	J
3	Date	Purchase order #	Req #	Name	Service	Requesting Organisation	CW	Price ex. GST	GST	Price inc. GST
4	LT CNCL 5/07/2021		95	one	Supervised contact			$219.30	$21.93	$241.23
5	LT CNCL 5/07/2021		95	two	Supervised Contact			$219.30	$21.93	$241.23
6	LT CNCL 5/07/2021		95	three	Supervised Contact			$219.30	$21.93	$241.23
7	5/07/2021		95	four	Supervised Contact
8	7/01/1900		58
9	8/01/1900		59
10	9/01/1900		60
11	10/01/1900		61
12	11/01/1900		62
13	12/01/1900		63
July

Cell Formulas
Range	Formula
I4:I6	I4	=IF(E4="Activities",0,H4*0.1)
J4:J6	J4	=I4+H4

Notice that up until this point, each row that has had yes pressed when it has been highlighted has been the correct row that has had the changes applied to it.

I run it one last time and press Yes as there is only one row visible and get this result.

CSS Work Allocation Sheet.83-1.xlsm
	A	B	C	D	E	F	G	H	I	J
3	Date	Purchase order #	Req #	Name	Service	Requesting Organisation	CW	Price ex. GST	GST	Price inc. GST
4	LT CNCL 5/07/2021		95	one	Supervised contact			$219.30	$21.93	$241.23
5	LT CNCL 5/07/2021		95	two	Supervised Contact			$219.30	$21.93	$241.23
6	LT CNCL 5/07/2021		95	three	Supervised Contact			$219.30	$21.93	$241.23
7	5/07/2021		95	four	Supervised Contact
8	7/01/1900		58
9	8/01/1900		59
10	LT CNCL 5/07/2021		60					$219.30	$21.93	$241.23
11	10/01/1900		61
12	11/01/1900		62
13	12/01/1900		63
July

Cell Formulas
Range	Formula
I4:I6,I10	I4	=IF(E4="Activities",0,H4*0.1)
J4:J6,J10	J4	=I4+H4

Notice the changes have been applied to row 10 instead of row 7, despite row 7 being the visible row after the filter.




Trying to use the autofilter feels like we are going in circles, chasing our tails.

I have decided that it would be better to highlight the rows instead of using the autofilter so I want to remove the autofilter. I have looked at the code but there are a few spots I am not sure about. This is the current code.

Sub LateCancel()
        Dim ws As Worksheet, sh As Worksheet, sht As Worksheet, QT As String, wb2 As Workbook, WbPath As String, QTPath As String
        Dim Serv As String, Month As String, Service As String, LCPrice As String, AutoFilterCounter As Long
        Set wb2 = ThisWorkbook
        'QT = "CSS_quoting_tool_29.5.xlsm"
        Set sh = wb2.Worksheets("Totals")

        'values on totals sheet that the user is looking for
        Dim LCReq As String: LCReq = sh.Cells(32, 2).Value
        'Dim LCDt As String: LCDt = sh.Cells(37, 2).Value
        Dim LCDt As String: LCDt = CDate(sh.Cells(37, 2).Value)
        Dim LateCancelHours As String: LateCancelHours = sh.Cells(35, 2).Value
        Dim SheetCounter As Long: SheetCounter = 0
       
        WbPath = ThisWorkbook.Path
        QTPath = ThisWorkbook.Path & "\..\" & "\..\"
'Call TurnOffFunctionality
        'If Not isFileOpen(DocYearName & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Work Allocation Sheets" & "\" & Site & "\" & DocYearName & ".xlsm"
        'If Not isFileOpen(QT) Then Workbooks.Open QTPath & "\" & QT
   
        For Each ws In wb2.Worksheets
                If ws.Name <> "Cancellations" And ws.Name <> "Totals" And ws.Name <> "Sheet2" Then
                        With ws.[A3].CurrentRegion
                                'On Error Resume Next
                                'Autofilter the late cancel date enter in B37 with dates in column 1
                                .AutoFilter 1, LCDt
                                'Autofilter the late cancel request number with request numbers in column 3
                                .AutoFilter 3, LCReq
                                'Check to see if the date cell, column A, for a job has anything in it. If it doesn't, turn the autofilter off and skip to the next sheet.
                                
                                If ws.[A3].Cells.Offset(1, 0) = "" Then
                                    .AutoFilter
                                    SheetCounter = SheetCounter + 1
                                    'If SheetCounter = 12, none of the 12 monthly sheets have the entered date and request number so let the user know
                                    If SheetCounter = 12 Then
                                        MsgBox "A job with the date and request number entered does not exist"
                                    End If
                                    GoTo SkipNextSheet
                                End If
                               
                                'Check the count Autofilter
                                AutoFilterCounter = .Columns(1).SpecialCells(xlCellTypeVisible).Count
                                'If value less than 2, only the heading is visible so skip to the next sheet.
                                If AutoFilterCounter < 2 Then
                                    .AutoFilter
                                    'Add 1 to a sheet counter
                                    SheetCounter = SheetCounter + 1
                                    'If SheetCounter = 12, none of the 12 monthly sheets have the entered date and request number so let the user know
                                    If SheetCounter = 12 Then
                                        MsgBox "A job with the date and request number entered does not exist"
                                    End If
                                    GoTo SkipNextSheet
                                End If
                               
                                    With Application.Intersect(.SpecialCells(xlCellTypeVisible), .Offset(1, 0))
                                        'Check if there is a service entered in column 5 of the filtered job.
                                       
                                        If .Areas(1).Cells(1, 5).Value = "" Then
                                            'Display a messagebox with a message and the sheet that has the missing service.
                                            MsgBox "There is a job in the " & ws.Name & " sheet that matches the date and request number but does not have a " & _
                                            "service type. Please add a service type to this job before continuing."
                                            Call TurnOnFunctionality
                                            .AutoFilter
                                           
                                           
                                            Exit Sub
                                        End If
                                        'If the service column, (5), has a value, store the service in the service variable.
                                        Service = .Areas(1).Cells(1, 5).Value
                                    End With
                               
                               
                                Dim j As Long
                                    j = ws.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
                                    '''VBA to count number of visible rows after autofilter row
                               
                                Dim LastRow As Long, i As Long
                                LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
                                Dim rng As Range: Set rng = ws.Range("A4:A" & LastRow)
                                'i = ws.Range("A4:A" & LastRow).SpecialCells(xlCellTypeVisible)
                                
                                Dim rws&: rws = ws.Range("A4:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeVisible).Count
                                'if this range is greater than 1, ask the below question, else continue
                                If rws > 0 Then
                                    With ws
                                        Dim answer As Integer
                                        Dim RowNumber As Long
                                        Application.ScreenUpdating = True
                                        LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
                                        For i = LastRow To 4 Step -1
                                                ws.Activate
                                                If .Rows(i).Hidden = False Then
                                                   .Rows(i).Interior.ColorIndex = 6
                                                   answer = MsgBox("Is this the job you want to apply the late cancel price too?", vbQuestion + vbYesNo + vbDefaultButton2, "Late Cancel Price")
                                                    .Rows(i).Interior.ColorIndex = 0
                                                End If
                                                If answer = vbYes Then
                                                    RowNumber = .Rows(i).Row - 3
                                                    GoTo FoundRightJob
                                                End If
                                                'If answer = vbNo
                                        Next i
                                    End With
                                End If
    
FoundRightJob:
                                'No has been selected each time so display a message box and exit sub
                                If RowNumber < 1 Then
                                    MsgBox "No jobs have been selected as a Late Cancel"
                                    .AutoFilter
                                    Exit Sub
                                End If
                                    'Copy data fom the job back to a calculator on the data sheet (this is the code name for sheet2) to calulcate the price again.
                                    With Data
                                        .Cells(30, 1) = CDate(LCDt)
                                        .Cells(30, 2) = Service
                                        'Set the hourly figure in the lateCanel table to be the LateCancelHours variable
                                        .Cells(30, 5) = LateCancelHours
                                        'A late cancel will be charged for 1 staff member attending
                                        'Therefore, set the Staff Req. figure to 1
                                        .Cells(30, 6) = 1
                                    End With
                                    On Error GoTo Price
                                        'Calculates price of late cancel on worksheet so the new price will be copied to the allocation sheet instead of the previous price
                                        Calculate
                                    LCPrice = Data.Cells(30, 8).Value
Price:
                                Select Case Err.Number
                                    Case Is = 13
                                        MsgBox "There is a problem with the spelling of the service type on the " & ws.Name & " sheet for the job that matches " _
                                        & "the date and request number. Please check the spelling and try again."
                                        .AutoFilter
                                        Call TurnOnFunctionality
                                        Exit Sub
                                End Select
                                On Error GoTo 0
                                With Application.Intersect(.SpecialCells(xlCellTypeVisible), .Offset(1, 0))
                                    Dim LTCnclDate As String
                                    .Areas(1).Cells(RowNumber, 1).Value = "LT CNCL " & .Areas(1).Cells(1, 1).Value
                                    .Areas(1).Cells(RowNumber, 8).Value = LCPrice
                                    .Areas(1).Cells(RowNumber, 9).Formula = "=IF(RC[-4]=""Activities"",0,RC[-1]*0.1)"
                                    .Areas(1).Cells(RowNumber, 10).Formula = "=RC[-1]+RC[-2]"
                                End With
                                .AutoFilter
                        End With
                End If
SkipNextSheet:
        Next ws
'Call TurnOnFunctionality
End Sub

1. If I am to remove the autofilter, firstly, I can comment out these lines

2. [*]                                'Autofilter the late cancel date enter in B37 with dates in column 1
                                   '.AutoFilter 1, LCDt
                                   'Autofilter the late cancel request number with request numbers in column 3
                                   '.AutoFilter 3, LCReq

3. 
   
4. 
   
5. With the next part

6. [*]                                If ws.[A3].Cells.Offset(1, 0) = "" Then
                                       '.AutoFilter
                                       SheetCounter = SheetCounter + 1
                                       'If SheetCounter = 12, none of the 12 monthly sheets have the entered date and request number so let the user know
                                       If SheetCounter = 12 Then
                                           MsgBox "A job with the date and request number entered does not exist"
                                       End If
                                       GoTo SkipNextSheet
                                   End If

7. Obviously, I will comment out the .autofilter but I wasn't sure how to check if the job existed on a set sheet. I can't use whether the cell is blank anymore as I won't have an autofilter.
8. 
   
9. 
   
10. With the next part

11.                                 'Check the count Autofilter
                                    AutoFilterCounter = .Columns(1).SpecialCells(xlCellTypeVisible).Count
                                    'If value less than 2, only the heading is visible so skip to the next sheet.
                                    If AutoFilterCounter < 2 Then
                                        .AutoFilter
                                        'Add 1 to a sheet counter
                                        SheetCounter = SheetCounter + 1
                                        'If SheetCounter = 12, none of the 12 monthly sheets have the entered date and request number so let the user know
                                        If SheetCounter = 12 Then
                                            MsgBox "A job with the date and request number entered does not exist"
                                        End If
                                        GoTo SkipNextSheet
                                    End If

12. I don't even know what this was doing. I do not think I need it if I have no autofilter. I found I needed it at the time but now I do now know why.
13. 
    
14. 
    
15. With the next part

16.                                     With Application.Intersect(.SpecialCells(xlCellTypeVisible), .Offset(1, 0))
                                            'Check if there is a service entered in column 5 of the filtered job.
                                            If .Areas(1).Cells(1, 5).Value = "" Then
                                                'Display a messagebox with a message and the sheet that has the missing service.
                                                MsgBox "There is a job in the " & ws.Name & " sheet that matches the date and request number but does not have a " & _
                                                "service type. Please add a service type to this job before continuing."
                                                Call TurnOnFunctionality
                                                .AutoFilter
                                                Exit Sub
                                            End If
                                            'If the service column, (5), has a value, store the service in the service variable.
                                            Service = .Areas(1).Cells(1, 5).Value
                                        End With

    
    
17. This section of code checks if the filtered row has a service type in column 5. Again, I am not sure how to adjust the code so it doesn't look at the filtered job as there will be no autofilter but the highlighted job.
18. 
    
19. 
    
20. With the next part

21. Dim j As Long
                                        j = ws.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
                                        '''VBA to count number of visible rows after autofilter row

22. I do not think I even need this part as there are no references to the variable J in the code anywhere.
23. 
    
24. 
    
25. With the next part

26. Dim LastRow As Long, i As Long
                                    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
                                    Dim rng As Range: Set rng = ws.Range("A4:A" & LastRow)

27. Just variable declarations
28. 
    
29. 
    
30. With the next part

31. Dim rws&: rws = ws.Range("A4:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeVisible).Count

32. This line counts the number of visible rows but if I am not using the autofilter, I need another way of counting the number of rows that match the criteria of the date and request number. I know the logic of what needs to happen but I am not sure how to code it.
33. 
    
34. 
    
35. With the next part

36. If rws > 0 Then
                                        With ws
                                            Dim answer As Integer
                                            Dim RowNumber As Long
                                            Application.ScreenUpdating = True
                                            LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
                                            For i = LastRow To 4 Step -1
                                                    ws.Activate
                                                    If .Rows(i).Hidden = False Then
                                                       .Rows(i).Interior.ColorIndex = 6
                                                       answer = MsgBox("Is this the job you want to apply the late cancel price too?", vbQuestion + vbYesNo + vbDefaultButton2, "Late Cancel Price")
                                                        .Rows(i).Interior.ColorIndex = 0
                                                    End If
                                                    If answer = vbYes Then
                                                        RowNumber = .Rows(i).Row - 3
                                                        GoTo FoundRightJob
                                                    End If
                                                    'If answer = vbNo
                                            Next i
                                        End With
                                    End If

    
    
37. I do not know what needs to be done here. I don't know how to identify a row that matches the criteria and not just rely on the autofilter being not activated.
38. 
    
39. 
    
40. With the next part

41. FoundRightJob:
                                    'No has been selected each time so display a message box and exit sub
                                    If RowNumber < 1 Then
                                        MsgBox "No jobs have been selected as a Late Cancel"
                                        .AutoFilter
                                        Exit Sub
                                    End If

42. I would take out the .autofilter but I am not sure if anything else would need to change.
43. 
    
44. 
    
45. With the next part

46. 'Copy data fom the job back to a calculator on the data sheet (this is the code name for sheet2) to calulcate the price again.
                                        With Data
                                            .Cells(30, 1) = CDate(LCDt)
                                            .Cells(30, 2) = Service
                                            'Set the hourly figure in the lateCanel table to be the LateCancelHours variable
                                            .Cells(30, 5) = LateCancelHours
                                            'A late cancel will be charged for 1 staff member attending
                                            'Therefore, set the Staff Req. figure to 1
                                            .Cells(30, 6) = 1
                                        End With

    
    
    
47. This part gets the date of the service, hours that will be charged for the late cancel and type of service, inputs it into a special calculator on the data sheet. The calculator will generate a price of the late cancel based on the date, hours and type of service. I don't think this needs to change.
48. 
    
49. 
    
50. With the next part

51. On Error GoTo Price
                                            'Calculates price of late cancel on worksheet so the new price will be copied to the allocation sheet instead of the previous price
                                            Calculate
                                        LCPrice = Data.Cells(30, 8).Value

52. This calculates and assigns the new price to the LCPrice variable
53. 
    
54. 
    
55. With the next part
56. Price:
    

    Select Case Err.Number
                                        Case Is = 13
                                            MsgBox "There is a problem with the spelling of the service type on the " & ws.Name & " sheet for the job that matches " _
                                            & "the date and request number. Please check the spelling and try again."
                                            .AutoFilter
                                            Call TurnOnFunctionality
                                            Exit Sub
                                    End Select

57. This is just an error handler to try and catch one of the common errors and let the user know why it didn't work. I think the .autofilter would need to be removed but I can't see anywhere else that would need changing.
58. 
    
59. 
    
60. With the next part

61. On Error GoTo 0
                                    With Application.Intersect(.SpecialCells(xlCellTypeVisible), .Offset(1, 0))
                                        Dim LTCnclDate As String
                                        .Areas(1).Cells(RowNumber, 1).Value = "LT CNCL " & .Areas(1).Cells(1, 1).Value
                                        .Areas(1).Cells(RowNumber, 8).Value = LCPrice
                                        .Areas(1).Cells(RowNumber, 9).Formula = "=IF(RC[-4]=""Activities"",0,RC[-1]*0.1)"
                                        .Areas(1).Cells(RowNumber, 10).Formula = "=RC[-1]+RC[-2]"
                                    End With
                                    .AutoFilter
                            End With
                    End If
    SkipNextSheet:
            Next ws
    'Call TurnOnFunctionality
    End Sub

62. This part of code assigns the changes to the selected row. Again, I don't know how to change the code so it is not just assigning it to the visible row, but assigning the changes to the highlighted row.

I am so sorry I have decided not to go with the autofilter after all this work has been done. If only I could have known the trouble that would have been presented with the autofilter.

I just think that not using the autofilter, but highlighting the rows instead would solve so many problems. I understand this is a big ask but I would greatly appreciate any help with the coding as I am still learning to code.


From the above list, here is a list of the parts that I am not sure about.

• Part 9,
• 14,
• 19,
• 24,
• 34,
• 39,
• 44,
• 49,
• 59,
• 64

Thankyou for helping me with this.

 

[Michael M]

Well, that is a fairly lengthy tome......when I think what I was suggesting was
Rather than autofilter, copy ALL rows across that meet "LCDt" & "LcReq" criteria THEN we can address them

 

[dpaton05]

What do you mean by that? Copy all the rows for the Late Cancel where?

The jobs that have a late cancel are meant to stay in the same sheet, just have the text Lt Cncl added to the front of the date.

 

[Michael M]

yeah sorry, Dave got lost in the forest....what I wanted to say was
Rather than Autofilter each sheet
1. Loop through the rows in the ws to check if they meet LCDt in Col "A" and LCReq in col "C"
2. Ask the question "do you want to Late cancel".....or is this necessary if the criteria has been met ??
2. If they meet said criteria add the LtCncl to the front of Col "A"
3. Move onto next ws

I don't follow the need for SheetCounter in 2 places, when you are looping through ALL sheets anyway !
But, I have been on the road for about 6 hours and could have chronic brain fade !!

 

[dpaton05]

Thanks for those Ideas Michael, I will have a go at it tomorrow when I am back at work.

 

[dpaton05]

Actually Michael, I just remembered, my supervisor is getting a little impatient that it's taking so long. Would you be able to help me a little with the code please?

 

[JLGWhiz]

This could be the culprit. The value of RowNumber and the value of ' i ' could be different. Not sure why Areas is being used here either, because the cells property then applies to Areas rather than worksheet. This entire macro has been a nightmare to unravel. No offense intended @dpaton05

:
On Error GoTo 0
                                With Application.Intersect(.SpecialCells(xlCellTypeVisible), .Offset(1, 0))
                                    Dim LTCnclDate As String
                                    .Areas(1).Cells(RowNumber, 1).Value = "LT CNCL " & .Areas(1).Cells(1, 1).Value
                                    .Areas(1).Cells(RowNumber, 8).Value = LCPrice
                                    .Areas(1).Cells(RowNumber, 9).Formula = "=IF(RC[-4]=""Activities"",0,RC[-1]*0.1)"
                                    .Areas(1).Cells(RowNumber, 10).Formula = "=RC[-1]+RC[-2]"
                                End With
                                .AutoFilter
                        End With
                End If
SkipNextSheet:

 

[Michael M]

I agree with @JLGWhiz
This has been a nightmare to debug, I hate spaghetti code. I'd ask @JLGWhiz to maybe have a look at this code as well......there are no guarantees with where we are going with this !!!
Try this in a COPY of YOUR Workbook
AND
Unfortunately, your Supervisors impatience isn't our immediate problem...

Sub MM1()
        Dim ws As Worksheet, sh As Worksheet, sht As Worksheet, QT As String, WbPath As String, QTPath As String
        Dim Serv As String, Month As String, Service As String, LCPrice As String
        Set sh = Sheets("Totals")

        'values on totals sheet that the user is looking for
        Dim LCReq As String: LCReq = sh.Cells(32, 2).Value
        Dim LCDt As String: LCDt = CDate(sh.Cells(37, 2).Value)
        Dim LateCancelHours As String: LateCancelHours = sh.Cells(35, 2).Value
       
        WbPath = ThisWorkbook.Path
        QTPath = ThisWorkbook.Path & "\..\" & "\..\"
        'If Not isFileOpen(DocYearName & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Work Allocation Sheets" & "\" & Site & "\" & DocYearName & ".xlsm"
        'If Not isFileOpen(QT) Then Workbooks.Open QTPath & "\" & QT
   
        For Each ws In Worksheets
                If ws.Name <> "Cancellations" And ws.Name <> "Totals" And ws.Name <> "Sheet2" Then
                        With ws
                        Dim lr As Long, r As Long
                            lr = .Cells(Rows.Count, "A").End(xlUp).Row
                            For r = 4 To lr
                            If .Cells(r, 1).Value = LCDt And .Cells(r, 3).Value = LCReq Then
                                If .Cells(r, 3).Offset(1, 0) = "" Then GoTo SkipNextSheet
                                        If .Cells(r, 5).Value = "" Then
                                            'Display a messagebox with a message and the sheet that has the missing service.
                                            MsgBox "There is a job in the " & ws.Name & " sheet that matches the date and request number but does not have a " & _
                                            "service type. Please add a service type to this job before continuing."
                                            Call TurnOnFunctionality
                                            Exit Sub
                                         End If
                                        'If the service column, (5), has a value, store the service in the service variable.
                                Service = .Cells(r, 5).Value
                                Dim LastRow As Long, answer As String
                                    Rows(r).Interior.ColorIndex = 6
                                        answer = MsgBox("Is this the job you want to apply the late cancel price too?", vbQuestion + vbYesNo + vbDefaultButton2, "Late Cancel Price")
                                        Rows(r).Interior.ColorIndex = 0
                                        If answer = vbYes Then
                                            GoTo FoundRightJob
                                        End If
                                       If answer = vbNo Then
                                            MsgBox "No jobs have been selected as a Late Cancel"
                                    Exit Sub
                                    End If
                                    End If
                             Next r

FoundRightJob:
                                  'Copy data fom the job back to a calculator on the data sheet (this is the code name for sheet2) to calulcate the price again.
                                    With Data
                                        .Cells(30, 1) = CDate(LCDt)
                                        .Cells(30, 2) = Service
                                        'Set the hourly figure in the lateCanel table to be the LateCancelHours variable
                                        .Cells(30, 5) = LateCancelHours
                                        'A late cancel will be charged for 1 staff member attending
                                        'Therefore, set the Staff Req. figure to 1
                                        .Cells(30, 6) = 1
                                    On Error GoTo Price
                                        'Calculates price of late cancel on worksheet so the new price will be copied to the allocation sheet instead of the previous price
                                        Calculate
                                    LCPrice = .Cells(30, 8).Value
                                    End With
Price:
                                If Err.Number = 13 Then
                                        MsgBox "There is a problem with the spelling of the service type on the " & ws.Name & " sheet for the job that matches " _
                                        & "the date and request number. Please check the spelling and try again."
                                        Exit Sub
                                End If
                                On Error GoTo 0
                                Dim LTCnclDate As String
                                    .Cells(r, 1).Value = "LT CNCL " & .Cells(r, 1).Value
                                    .Cells(r, 8).Value = LCPrice
                                    .Cells(r, 9).Formula = "=IF(RC[-4]=""Activities"",0,RC[-1]*0.1)"
                                    .Cells(r, 10).Formula = "=RC[-1]+RC[-2]"
                       
                        End With
                End If
SkipNextSheet:
        Next ws
End Sub

 

[dpaton05]

No offense intended @dpaton05

No offense taken. All of the code I have produced on here has basically been written by other people and I have just tried to put bits and pieces together. That is why it appears to be spaghetti code, I do not understand the best way to write code, hey, I hardly understand much about coding.

 

[dpaton05]

Thanks Michael but that adds a line onto every monthly worksheet and doesn't activate the worksheet that has the row.

Before the sub is run

CSS Work Allocation Sheet.84.xlsm
	A	B	C	D	E	F	G	H	I	J
3	Date	Purchase order #	Req #	Name	Service	Requesting Organisation	Caseworker Name	Price ex. GST	GST	Price inc. GST
4	5/07/2021		95	one	Supervised contact
5	5/07/2021		95	two	Supervised Contact
6	5/07/2021		95	three	Supervised Contact
7	6/01/1900		57	four	Supervised Contact
8	7/01/1900		58
9	8/01/1900		59
July

Cells with Data Validation
Cell	Allow	Criteria
F4:J4	Any value

After the sub is run and hitting Yes the first time i get asked the question:

This is the July sheet

CSS Work Allocation Sheet.84.xlsm
	A	B	C	D	E	F	G	H	I	J
3	Date	Purchase order #	Req #	Name	Service	Requesting Organisation	Caseworker Name	Price ex. GST	GST	Price inc. GST
4	LT CNCL 5/07/2021		95	one	Supervised contact			$219.30	$21.93	$241.23
5	5/07/2021		95	two	Supervised Contact
6	5/07/2021		95	three	Supervised Contact
7	6/01/1900		57	four	Supervised Contact
8	7/01/1900		58
9	8/01/1900		59
July

Cell Formulas
Range	Formula
I4	I4	=IF(E4="Activities",0,H4*0.1)
J4	J4	=I4+H4

Cells with Data Validation
Cell	Allow	Criteria
F4:J4	Any value

Every other monthly sheet is the same as this one

CSS Work Allocation Sheet.84.xlsm
	A	B	C	D	E	F	G	H	I	J
3	Date	Purchase order #	Req #	Name	Service	Requesting Organisation	Caseworker Name	Price ex. GST	GST	Price inc. GST
4	LT CNCL							$219.30	$21.93	$241.23
5
6
7
August

Cell Formulas
Range	Formula
I4	I4	=IF(E4="Activities",0,H4*0.1)
J4	J4	=I4+H4

Cells with Data Validation
Cell	Allow	Criteria
F5	Any value
F6:H7	Any value
F4:H4	Any value