Nlhicks
Active Member
- Joined
- Jan 8, 2021
- Messages
- 264
- Office Version
- 365
- Platform
- 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.
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
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