Autofilter is filtering to nothing

Nlhicks

Active Member
Joined
Jan 8, 2021
Messages
264
Office Version
  1. 365
Platform
  1. Windows
My original code would filter to the right row but this code is filtering to nothing as shown below: Help figuring out how to get it to show the right row when entering the given criteria from the user.

1670427988152.png



Sub FindRightRow2()

Dim Rowz As Integer
Dim Wb As Workbook
Dim wbMaster As Workbook
Dim wsXfmrMaster As Worksheet
Dim wbUpdate As Workbook
Dim wsFacility As Worksheet
Dim sValue As String
Dim strFile As String
Dim strWbVersion As String


Const cstrPath As String = "C:\Users\nhicks\Documents\Ratings\Saved Versions\"
Const cstrStFileName As String = "WAPA-UGPR Facility Rating and SOL Record (Data File)_v"
Const cstrwbMaster As String = "WAPA-UGPR Facility Rating and SOL Record (Master).xlsm"
Const cstrMasterUpdate As String = "Xfmr Update"
Const cstrShFacility As String = "Facility Ratings & SOLs (Xfmrs)"


strWbVersion = HighestVersion(cstrPath, ".xlsm", cstrStFileName)
If Len(strWbVersion) = 0 Then
MsgBox "Could not spot a version of " & vbCrLf & cstrStFileName & _
vbCrLf & "in Path " & cstrPath, vbInformation, cstrMsgTitle
GoTo end_here
End If

For Each Wb In Workbooks
If LCase(Wb.Name) = LCase(cstrwbMaster) Then
Set wbMaster = Wb
Exit For
End If
Next Wb
If wbMaster Is Nothing Then
If Dir(cstrwbMaster) <> "" Then
Set wbMaster = Workbooks.Open(cstrwbMaster)
Else
MsgBox "Could not find '" & cstrwbMaster & "' in current folder. Please open workbook and start again.", vbInformation, cstrMsgTitle
GoTo end_here
End If
End If
If Evaluate("ISREF('[" & cstrwbMaster & "]" & cstrMasterUpdate & "'!A1)") Then
Set wsXfmrMaster = wbMaster.Sheets(cstrMasterUpdate)
Else
MsgBox "Sheet '" & cstrMasterUpdate & "' not found in workbook '" & cstrwbMaster, vbInformation, cstrMsgTitle
GoTo end_here
End If

For Each Wb In Workbooks
If LCase(Wb.Name) = LCase(strWbVersion) Then
Set wbUpdate = Wb
Exit For
End If
Next Wb
If wbUpdate Is Nothing Then
If Dir(IIf(Right(cstrPath, 1) = "\", cstrPath, cstrPath & "\") & strWbVersion) <> "" Then
Set wbUpdate = Workbooks.Open(IIf(Right(cstrPath, 1) = "\", cstrPath, cstrPath & "\") & strWbVersion)
Else
MsgBox "Could not find '" & strWbVersion & "' in " & cstrPath & ". Please open workbook and start again.", vbInformation, cstrMsgTitle
GoTo end_here
End If
End If
If Evaluate("ISREF('[" & strWbVersion & "]" & cstrShFacility & "'!A1)") Then
Set wsFacility = wbUpdate.Sheets(cstrShFacility)
Else
MsgBox "Sheet '" & cstrShFacility & "' not found in workbook '" & strWbVersion, vbInformation, cstrMsgTitle
GoTo end_here
End If

Application.ScreenUpdating = False

With wsFacility
If wsXfmrMaster.Range("D3").Value <> "" Then
.Range("A1").CurrentRegion.AutoFilter field:=1, Criteria1:="*" & wsXfmrMaster.Range("C3") & "*"
End If
If wsXfmrMaster.Range("D4").Value <> "" Then
.Range("A1").CurrentRegion.AutoFilter field:=2, Criteria1:="*" & wsXfmrMaster.Range("C4") & "*"
End If

'changed to let the function look for the used range in Column A
Rowz = Application.WorksheetFunction.Subtotal(3, .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row))
Debug.Print Rowz
If Rowz <= 1 Then
wsXfmrMaster.Range("D8").Value = .Range("C2:C188").SpecialCells(xlCellTypeVisible)
wsXfmrMaster.Range("D9").Value = .Range("D2:D188").SpecialCells(xlCellTypeVisible)
wsXfmrMaster.Range("D10").Value = .Range("E2:E188").SpecialCells(xlCellTypeVisible)
wsXfmrMaster.Range("D11").Value = .Range("F2:F188").SpecialCells(xlCellTypeVisible)
wsXfmrMaster.Range("D12").Value = .Range("G2:G188").SpecialCells(xlCellTypeVisible)
wsXfmrMaster.Range("D13").Value = .Range("H2:H188").SpecialCells(xlCellTypeVisible)
wsXfmrMaster.Range("D14").Value = .Range("I2:I188").SpecialCells(xlCellTypeVisible)
wsXfmrMaster.Range("D15").Value = .Range("J2:J188").SpecialCells(xlCellTypeVisible)
wsXfmrMaster.Range("D16").Value = .Range("K2:K188").SpecialCells(xlCellTypeVisible)
wsXfmrMaster.Range("D17").Value = .Range("L2:L188").SpecialCells(xlCellTypeVisible)
wsXfmrMaster.Range("D18").Value = .Range("M2:M188").SpecialCells(xlCellTypeVisible)
wsXfmrMaster.Range("D19").Value = .Range("N2:N188").SpecialCells(xlCellTypeVisible)
wsXfmrMaster.Range("D20").Value = .Range("O2:O188").SpecialCells(xlCellTypeVisible)
wsXfmrMaster.Range("D21").Value = .Range("P2:P188").SpecialCells(xlCellTypeVisible)
wsXfmrMaster.Range("D22").Value = .Range("Q2:Q188").SpecialCells(xlCellTypeVisible)
wsXfmrMaster.Range("D23").Value = .Range("R2:R188").SpecialCells(xlCellTypeVisible)

End If

End With
end_here:
Set wsXfmrMaster = Nothing
Set wsFacility = Nothing
Set wbUpdate = Nothing
Set wbMaster = Nothing
Application.ScreenUpdating = True


End Sub




1670427867481.png
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Never mind you can delete this post I figured it out:oops:
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,849
Members
452,361
Latest member
d3ad3y3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top