How to get first visible row after filter in vba? (worked before but not anymore)-CodePudding

I have this code that filters a range and then gets the first visible line's row at its beginning.

I used to do it in this very code before, and it worked just fine. I had looked up different methods (currentregion, specialcells etc) and decided to go with specialcells.

But then I changed my code just a little, and had to do it twice -same original set of data gets filtered and first rowed, and then I do it again with another file. But even though both the data and all code related to my first set remained unchanged, it keeps throwing 'error 1004 - error defined by application or object' on a = wsf.AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row ('a' just being a variable to stock the row number). Again, 'wsf' is defined from the same file with the same data at the same moment in the code and nothing else related to it changed. I merely moved up 'wsa' 's declaration, which shouldn't interfere in any way.

I looked up everywhere for what could be wrong but couldn't find anything. Tried any other method I could find. At some point it stopped throwing an error but the row returned was always, without fault, 1, despite changing either the offset row value or the specialcells row value... instead of 48k as it should in my tests. What's more, its twin 3 lines below works alright. Both files are xlsm, both sheets are correctly set and filtered. I'm very confused and tired bout this.

Sorry I only ask you guys stupid stuff like that but I can't stand it anymore.


Dim deb As Date: deb = Now()
Dim owa As Workbook: Set owa = ThisWorkbook
Dim ows As Worksheet: Set ows = owa.Worksheets("Feuil1")
Dim PremAg As Range: Set PremAg = ows.Range("w2")
Dim LastAg As Range: Set LastAg = ows.Range("w" & ows.Cells(Rows.Count, "w").End(xlUp).Row)
Dim RngAg As Range: Set RngAg = ows.Range(PremAg, LastAg) 'full list of criterias I'll apply

Dim CellClient As Range
Dim CellFact As Range
Dim Agence As String
Dim wba As Workbook 'file with clients' info
Dim wsa As Worksheet 'relevant sheet 
Dim RngClient As Range 'full list of clients' IDs according to client file
Dim RngFact As Range 'same but for invoices file
Dim Poubelle As Range 'Trash that stocks used up invoices to then delete them once I used them
Dim n As Integer
n = 0
Dim wbf As Workbook 'invoices file
Dim wsf As Worksheet 'relevant sheet for invoices
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer

Set wbf = Workbooks.Open("C:\Users\QNS691\OneDrive\Documents\Excel\par agence 5\facts torturées2.xlsm")
Set wsf = wbf.Worksheets(1)

Set wba = Workbooks.Open("C:\Users\QNS691\OneDrive\Documents\Excel\par agence 5\full.xlsm")
Set wsa = wba.Worksheets(1)

Application.DisplayAlerts = False

For Each CellAg In RngAg

    wsf.Range("A1").AutoFilter field:=7, Criteria1:=CStr(CellAg) 'filter works well
    a = wsf.AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row 'and then there's this little thing that worked just fine but then threw a fit
    b = wsf.Range("g1").End(xlDown).Row
    
    wsa.Range("A1").AutoFilter field:=7, Criteria1:=CellAg
    c = wsa.AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row 'while that one works ok...
    d = wsa.Range("g1").End(xlDown).Row
    
    Set RngFact = wsf.Range("g" & a, "g" & b)
    
    Set RngClient = wsa.Range("g" & c, "g" & d)
            
    For Each CellClient In RngClient
        n = 0
        ag = wsa.Cells(CellClient.Row, 7)
        For Each CellFact In RngFact
            If CellClient = CellFact And ag = wsf.Cells(CellFact.Row, 7) Then
                n = n   1
                If Poubelle Is Nothing Then
                    Set Poubelle = CellFact
                Else
                    Set Poubelle = Union(Poubelle, CellFact)
                End If
            End If
        Next CellFact
        
        If Not Poubelle Is Nothing Then
            'Debug.Print Poubelle.Address
            Poubelle.EntireRow.Delete
        End If
        Set Poubelle = Nothing

        If n > 1 Then
            wsa.Cells(CellClient.Row, 9) = n
        End If
        
    Next CellClient
    
    wba.Save
    wbf.Save
Next CellAg
Application.DisplayAlerts = True
MsgBox y & Chr(10) & deb & " " & Now()

End Sub

CodePudding user response：

I can't reproduce the error you are getting with a number of scenarios I know can cause problems with filtered ranges. For instance, wsf.AutoFilter.Range.Offset(1, 0) will include the visible empty row below the filtered range. Also b = wsf.Range("g1").End(xlDown).Row can move to the end of the sheet (row 1048576) if no data match the criteria.

A different solution without using filters would be to use a dictionary object. Note I have disabled the row delete line and replaced it with a colour marker for testing purposes. For example ;

Option Explicit

Sub demo()

    Const FOLDER = "C:\Users\QNS691\OneDrive\Documents\Excel\par agence 5\"

    Dim owa As Workbook, ows As Worksheet, dictCrit
    Dim wbf As Workbook, wsf As Worksheet
    Dim wba As Workbook, wsa As Worksheet
    Dim i As Long, r As Long, n As Long, k, t0 As Single
    t0 = Timer
   
    Set owa = ThisWorkbook
    Set ows = owa.Sheets("Feuil1")
    
    ' dictionary with criteria as key, counts as values
    Set dictCrit = CreateObject("Scripting.Dictionary")
   
    ' criteria to apply
    With ows
        r = .Cells(.Rows.Count, "W").End(xlUp).Row
        If r < 2 Then
            MsgBox "No criteria in col W on sheet " & ows.Name, vbCritical
            Exit Sub
        End If
        'build dictionary
        For i = 2 To r
            k = Trim(.Cells(i, "W"))
            If dictCrit.exists(k) Then
                MsgBox "Duplicate criteria: " & k, vbCritical, ows.Name & " Col W Row " & i
                Exit Sub
            Else
                dictCrit.Add k, 0
            End If
        Next
    End With
    
    Set wba = Workbooks.Open(FOLDER & "full.xlsm")
    Set wsa = wba.Worksheets(1)
    With wsa
       r = .Cells(.Rows.Count, "G").End(xlUp).Row
       If r < 2 Then
           MsgBox "No data in col G on sheet " & wsa.Name, vbCritical
           Exit Sub
       End If
    End With
   
    Set wbf = Workbooks.Open(FOLDER & "facts torturées2.xlsm")
    Set wsf = wbf.Worksheets(1)
    Dim colG As String ' col 7
    
    With wsf
       r = .Cells(.Rows.Count, "G").End(xlUp).Row
       If r < 2 Then
           MsgBox "No data in col G on sheet " & wsf.Name, vbCritical
           Exit Sub
       End If
         
        ' scan up facts sheet counting record and deleting matches
        Application.ScreenUpdating = False
        For i = r To 2 Step -1
            colG = Trim(.Cells(i, "G"))
            If dictCrit.exists(colG) Then
                dictCrit(colG) = dictCrit(colG)   1
                .Cells(i, "G").Interior.Color = vbRed
                '.Rows(i).Delete
                n = n   1
            End If
        Next
        Application.ScreenUpdating = True
    End With
    
     ' delete zero counts
    For Each k In dictCrit.keys
        If dictCrit(k) = 0 Then dictCrit.Remove k
    Next
    
    ' update full.xlsm with counts
    With wsa
        r = .Cells(.Rows.Count, "G").End(xlUp).Row
        ' scan down and update counts
        Application.ScreenUpdating = False
        For i = 2 To r
            colG = Trim(.Cells(i, "G"))
            If dictCrit.exists(colG) Then
                .Cells(i, "I") = dictCrit(colG)  ' col 9
                dictCrit.Remove colG
            End If
        Next
        Application.ScreenUpdating = True
    End With
    'wba.Save
    'wbf.Save
    
    ' check all updated
    If dictCrit.Count > 0 Then
        MsgBox "Counts not updated for" & vbLf & Join(dictCrit.keys, vbLf), vbCritical
    Else
        MsgBox n & " rows deleted", vbInformation, "Run time = " & Format(Timer - t0, "0.0 secs")
    End If
End Sub