dpaton05
Well-known Member
- Joined
- Aug 14, 2018
- Messages
- 2,392
- Office Version
- 365
- 2016
- Platform
- Windows
I have a problem with my autofilter not appearing to match the results exactly. My filtered rows are not highlighting in order, let me explain:
This is my whole sub:
My spreadsheet contains financial data with the distinguishing factors for each record/row being a combination of a date and a request number. There are sheets for every month of the year.
When the autofilter hides the appropriate rows, if there are multiple matches in the remaining rows, I have code that cycles through the remaining visible rows and asks the question, Is this the row?
My spreadsheet looks like this:
These are the steps I take and the results I get
Thanks
This is my whole sub:
VBA 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
'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
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:
'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 SubMy spreadsheet contains financial data with the distinguishing factors for each record/row being a combination of a date and a request number. There are sheets for every month of the year.
When the autofilter hides the appropriate rows, if there are multiple matches in the remaining rows, I have code that cycles through the remaining visible rows and asks the question, Is this the row?
My spreadsheet looks like this:
| CSS Work allocation sheet.xlsx | ||||||
|---|---|---|---|---|---|---|
| A | B | C | D | |||
| 3 | Date | Purchase order # | Req # | Name | ||
| 4 | 5/07/2021 | 95 | ||||
| 5 | 5/07/2021 | 95 | ||||
| 6 | 5/07/2021 | 95 | ||||
| 7 | 5/07/2021 | 95 | ||||
| 8 | 8/07/2021 | 5432 | ||||
| 9 | 9/07/2021 | 5433 | ||||
| 10 | 10/07/2021 | 5434 | ||||
| 11 | 11/07/2021 | 5435 | ||||
| 12 | 12/07/2021 | 5436 | ||||
| 13 | 13/07/2021 | 5437 | ||||
| 14 | 14/07/2021 | 5438 | ||||
| 15 | 15/07/2021 | 5439 | ||||
| 16 | 16/07/2021 | 5440 | ||||
| 17 | 17/07/2021 | 5441 | ||||
| 18 | 18/07/2021 | 5442 | ||||
| 19 | 19/07/2021 | 5443 | ||||
| 20 | 20/07/2021 | 5444 | ||||
| 21 | 21/07/2021 | 5445 | ||||
| 22 | 22/07/2021 | 5446 | ||||
| 23 | 23/07/2021 | 5447 | ||||
| 24 | 24/07/2021 | 5448 | ||||
July | ||||||
These are the steps I take and the results I get
- I have 4 rows, 2-5, that have identical data in them. 5/07/2021 as the date and 95 as the request number.
- I enter the date and request number on the totals sheet
- This is where I enter the data
CSS Work allocation sheet.xlsx A B C D E F G 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- When I run the LateCancel sub the July is activated with the first matching row highlighted and the rows are filtered to show only the rows with the date and request number so only 4 rows appear
- I press no and the box appears again with the following match/row highlighted
- I press Yes and the correct row, being the second row has the late cancel price applied to it.
- The date on that row now looks like this
- LT CNCL 5/07/2021
- All the rows are now unfiltered
- The spreadsheet looks like this
CSS Work allocation sheet.xlsx A B C D 3 Date Purchase order # Req # Name 4 5/07/2021 95 5 LT CNCL 5/07/2021 95 6 5/07/2021 95 7 5/07/2021 95 8 8/07/2021 5432 9 9/07/2021 5433 10 10/07/2021 5434 11 11/07/2021 5435 12 12/07/2021 5436 13 13/07/2021 5437 14 14/07/2021 5438 15 15/07/2021 5439 16 16/07/2021 5440 17 17/07/2021 5441 18 18/07/2021 5442 19 19/07/2021 5443 20 20/07/2021 5444 21 21/07/2021 5445 22 22/07/2021 5446 23 23/07/2021 5447 24 24/07/2021 5448 July- If I then run the code again from the totals sheet without changing anything, the July sheet is activated again but now there are only 3 filtered results. Only rows 4,6 & 7 are visible with row 4 being highlighted
- I press No on the question and seeing as though row 6 is the next filtered row, I would expect row 6 to be highlighted as the next row but after I press No, there are no rows that are highlighted. My guess is it is still highlighting row 5 because after you press No again, row 6 becomes highlighted.
- Not sure why it is doing that but it needs to cycle through the cells that match the filter exactly, ie, 5/07/2021, not LT CNCL 5/07/2021 for the date and 95 for the request number or maybe cycle through the visible rows instead
- Not sure if this has an impact but the date column is formatted as date
Thanks
