Object variable or With Block variable not set

[sparky2205]

Hi folks,
in the following code I'm getting the above error.

Sub Filter_By_Category()

Dim lastrow As Long
Dim count As Long
Dim count1 As Long
Dim lvalue As Long
Dim category As String
Dim srange As Long

    srange = 9
    lastrow = Cells(Rows.count, 3).End(xlUp).Row
    ' Hide all vendors
    Rows("9:" & lastrow).EntireRow.Hidden = True
    category = Application.InputBox("By which Category do you wish to filter?", Type:=2)
    count = WorksheetFunction.CountIf(Range("I9:I" & lastrow), category)

    For i = 1 To count
        If i = 1 Then
            lvalue = Range("I" & srange & ":I" & lastrow).Find(category).Row + 8
        Else
            lvalue = Range("I" & srange & ":I" & lastrow).Find(category).Row
        End If
'        lvalue = Application.Match(category, Sheets("Revised").Range("I"& srange & ":I" & lastrow), 0) + 8
        Rows(lvalue & ":" & (lvalue + 3)).Hidden = False
        srange = lvalue + 3
    Next i

    'lvalue = WorksheetFunction.XLookup(category, Range("I9:I" & lastrow), Range("I9:I" & lastrow), "Selected category not found")

End Sub

It errors at:

lvalue = Range("I" & srange & ":I" & lastrow).Find(category).Row + 8

i.e. the first IF statement.
"category" is populated with a value that exists in column I

It worked fine yesterday, but has decided not to work today.
Any thoughts?

 

[sparky2205]

Yeah, I understand it's difficult when you don't know the exact scenario you are dealing with. Thanks for persevering.
The new code is returning the first entry but then it returns part of another entry and then nothing else.
This is complicated by the fact that I didn't have that part of the code working properly in the first place. I was working on that when I suddenly encountered the error.
I'm attaching a screenshot of what the file looks like, that might help.
I could also create a dumbed down version of the file and upload a link if that would help?

There are more columns in the file but this should give you a good idea of what I'm trying to achieve.
When the user clicks a button they are prompted for the category.
The result is e.g. selecting category C will display rows 21-24, 25-28, 33-36, 41-44 etc. like this:

Your latest code resulted in:

 

[sparky2205]

This is a link to a dumbed down version of the file:

File Transfer

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

 

[Alex Blakenburg]

I am not sure it wouldn't be easier to just do a normal loop with a step 4 but try this using the current methodology

    Dim FoundRow As Long
    For i = 1 To count
        With Application
            FoundRow = .IfError(.Match(category, Range("I" & srange & ":I" & lastrow), 0), 0)
        End With
        If FoundRow = 0 Then Exit For
        lvalue = FoundRow + srange - 1
        Rows(lvalue & ":" & (lvalue + 3)).Hidden = False
        srange = lvalue + 4
    Next i

 

[Alex Blakenburg]

I just tried it on your file and its too slow for my liking. You definitely need to add Application.ScreenUpdating = False at the beginning and True at the end.

Have you considered using helper columns in say AY so that you can populate every line (fill down) and then use that for the autofilter ?

 

[sparky2205]

I have a little bit more testing to do on this and I'm tied up for the next couple of hours but, first impressions are that this is working.
I will get back to you in a few hours when I've had the time to fully test it but I wanted to let you know it looks good.
Thanks a million Alex.

 

[Alex Blakenburg]

Turning off calculations made a big difference and unhiding in blocks (of range areas) helped a little too.

Sub Filter_By_Category_Match_Areas()

Dim lastrow As Long
Dim count As Long
Dim count1 As Long
Dim lvalue As Long
Dim category As String
Dim srange As Long
Dim i As Long

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
    srange = 9
    lastrow = Cells(Rows.count, 3).End(xlUp).Row
    ' Hide all vendors
    Rows("9:" & lastrow).EntireRow.Hidden = True
    category = Application.InputBox("By which Category do you wish to filter?", Type:=2)
    count = WorksheetFunction.CountIf(Range("I9:I" & lastrow), category)
                          
    Dim FoundRow As Long
    Dim strRowsToHide As String
    Dim rngVisible As Range
    For i = 1 To count
        With Application
            FoundRow = .IfError(.Match(category, Range("I" & srange & ":I" & lastrow), 0), 0)
        End With
        If FoundRow = 0 Then Exit For
        lvalue = FoundRow + srange - 1

        If rngVisible Is Nothing Then
            Set rngVisible = Rows(lvalue & ":" & (lvalue + 3))
        Else
            Set rngVisible = Union(rngVisible, Rows(lvalue & ":" & (lvalue + 3)))
        End If
        srange = lvalue + 4
    Next i
  
    Dim areaVisible As Range
    For Each areaVisible In rngVisible.Areas
        areaVisible.EntireRow.Hidden = False
    Next areaVisible
  
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

 

[sparky2205]

This works well, except where the user enters a nonexistent category.
Then areaVisible Is Nothing and we're back to our old friend, the withblock variable not set error.
Where is areaVisible set equal to something?

I've tried a bit of error proofing but it got stuck in a loop.
What I wanted was, if a user enters an incorrect category, they are presented with a msgbox telling them that and then presented with the input box again.
You'll see my name against my attempt below.

Sub Filter_By_Category1()

Dim lastrow As Long
Dim count As Long
Dim count1 As Long
Dim lvalue As Long
Dim category As String
Dim srange As Long
Dim i As Long

'On Error GoTo errhandler

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
    srange = 9
    lastrow = Cells(Rows.count, 3).End(xlUp).Row
    ' Hide all vendors
    Rows("9:" & lastrow).EntireRow.Hidden = True
cat:    category = Application.InputBox("By which Category do you wish to filter?", Type:=2)
    count = WorksheetFunction.CountIf(Range("I9:I" & lastrow), category)
                          
    Dim FoundRow As Long
    Dim strRowsToHide As String
    Dim rngVisible As Range
    For i = 1 To count
        With Application
            FoundRow = .IfError(.Match(category, Range("I" & srange & ":I" & lastrow), 0), 0)
        End With
        If FoundRow = 0 Then Exit For
        lvalue = FoundRow + srange - 1

        If rngVisible Is Nothing Then
            Set rngVisible = Rows(lvalue & ":" & (lvalue + 3))
        Else
            Set rngVisible = Union(rngVisible, Rows(lvalue & ":" & (lvalue + 3)))
        End If
        srange = lvalue + 4
    Next i
  
    Dim areaVisible As Range
    If areaVisible Is Nothing Then                  '******Joe******
        MsgBox "Category not found"                 '******Joe******
        GoTo cat                                    '******Joe******
    Else                                            '******Joe******
    For Each areaVisible In rngVisible.Areas
        areaVisible.EntireRow.Hidden = False
    Next areaVisible
    End If                                          '******Joe******
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

errhandler:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[Alex Blakenburg]

This line should return count = 0 if they pick an non-existent category:

    count = WorksheetFunction.CountIf(Range("I9:I" & lastrow), category)

You can trap that and give a message box and maybe exit the sub.

If you want to do a loop then typically you would just allow 3 tries and that would need some extra code.

I am login off for the night though.

 

[sparky2205]

I'll work it out Alex.
Thanks again for your help. This will get me to where I want to be.

 

[Alex Blakenburg]

Sounds good. Have a good rest of the day.