VBA optimisation - takes too long to process

[Fredoub20]

Hi guys! first time posting here.
I'm french canadian so sorry about my poor english.

So basically i wanna make like a little database on Excel with notes/jurisprudence/doctrine/laws and for every entry that i add on this sheet, i'm giving the notes/jurisprudence/doctrine/laws a tag on the column named tags. It looks like that :

First i wanted to sort the column by tags but the way i entered the tags it gave me only this option, and i knew i couldnt do it without VBA.

So after a couple hours of searching i made a button called "Rechercher" (Search) and a button "Reset". I click on the button "Search" after i've entered up to 4 criteria (i.e. tags) in the "#1, #2, #3, #4" spaces on top of the sheet. When i click "Search", this is what it does :

The thing is it's lagging so much when i click the button and it takes like 10 seconds to do what i want it to do. Can i optimise the code in a way or is my method of filtering the tags separated by comma too complicated ?

Thanks a lot in advance !

Also i have another problem i'm gonna throw in there. I wanna fit the size of the cells to match the text inside of it, but even if i click there ...

...or if i use the button "AutoFit Row Height", it doesnt work.
Anything to work around that ?

Thanks

Fred

 

[GWteB]

Hi Fred, Welcome to MrExcel.

I think the Find method is suitable for your purpose.
It's not clear from the images you have attached how the data relates to the column names and row numbers, so replacement code is not yet included. Consider downloading the XL2BB tool so you're able to post example data on this board which then can be copied by helpers on this forum.

 

[Fredoub20]

Thanks for your quick answer !
my excel doesnt respond when i try to use the tool :/ , in the meantime, here's another picture if it can help.

 

[Fredoub20]

Can i upload my excel sheet direcly ? cannot make the XL2BB work..

 

[offthelip]

If you post your code ( as text) rather than an image of it, I might modify it to make it faster!! I don't want to have to retype all your code to make a small modification
Click the VBA icon to format your code as code on this forum.

 

[GWteB]

See if this works for you. To be pasted in a standard code module.

Public Sub CustomSearch()

    Dim Sht As Worksheet
    Set Sht = ThisWorkbook.Worksheets("Sheet1")     ' <<< change sheet name to suit
    
    With Sht
        Dim Rng As Range
        Set Rng = .Range("A3", Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count))
        Dim arr As Variant
        arr = Rng.Offset(-2).Resize(1) 
    End With
    
    Application.ScreenUpdating = False
    Rng.EntireRow.Hidden = False
    
    Dim i As Long
    For i = 2 To UBound(arr, 2) Step 2
        Dim c As Range, Result As Range
        Set c = FindSomeText(arr(1, i), Rng)
        If Not c Is Nothing Then
            If Result Is Nothing Then
                Set Result = c
            Else
                Set Result = Application.Union(Result, c)
            End If
        End If
    Next i
    If Not Result Is Nothing Then
        Rng.EntireRow.Hidden = True
        Result.EntireRow.Hidden = False
    End If
    Application.ScreenUpdating = True
End Sub


Public Function FindSomeText(ByVal argText As String, ByVal argRng As Range) As Range
    Dim c As Range, StartAddr As String
    If Len(argText) > 0 Then
        Set c = argRng.Find(argText, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByRows)
        If Not c Is Nothing Then
            StartAddr = c.Address
            Do
                If FindSomeText Is Nothing Then
                    Set FindSomeText = c
                Else
                    Set FindSomeText = Application.Union(FindSomeText, c)
                End If
                Set c = argRng.FindNext(c)
            Loop While Not c Is Nothing And c.Address <> StartAddr
        End If
    End If
End Function

 

[Fredoub20]

If you post your code ( as text) rather than an image of it, I might modify it to make it faster!! I don't want to have to retype all your code to make a small modification
Click the VBA icon to format your code as code on this forum.

Here you go!

Sub Bouton6_Cliquer()

For i = 3 To 500
If InStr(Cells(i, 7), Range("b1").Value) > 0 And InStr(Cells(i, 7), Range("d1").Value) > 0 And InStr(Cells(i, 7), Range("f1").Value) > 0 And InStr(Cells(i, 7), Range("h1").Value) > 0 Then
Cells(i, 7).EntireRow.Hidden = False
Else
Cells(i, 7).EntireRow.Hidden = True
End If

Next i
End Sub

 

[Fredoub20]

See if this works for you. To be pasted in a standard code module.

Public Sub CustomSearch()

    Dim Sht As Worksheet
    Set Sht = ThisWorkbook.Worksheets("Sheet1")     ' <<< change sheet name to suit
   
    With Sht
        Dim Rng As Range
        Set Rng = .Range("A3", Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count))
        Dim arr As Variant
        arr = Rng.Offset(-2).Resize(1)
    End With
   
    Application.ScreenUpdating = False
    Rng.EntireRow.Hidden = False
   
    Dim i As Long
    For i = 2 To UBound(arr, 2) Step 2
        Dim c As Range, Result As Range
        Set c = FindSomeText(arr(1, i), Rng)
        If Not c Is Nothing Then
            If Result Is Nothing Then
                Set Result = c
            Else
                Set Result = Application.Union(Result, c)
            End If
        End If
    Next i
    If Not Result Is Nothing Then
        Rng.EntireRow.Hidden = True
        Result.EntireRow.Hidden = False
    End If
    Application.ScreenUpdating = True
End Sub


Public Function FindSomeText(ByVal argText As String, ByVal argRng As Range) As Range
    Dim c As Range, StartAddr As String
    If Len(argText) > 0 Then
        Set c = argRng.Find(argText, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByRows)
        If Not c Is Nothing Then
            StartAddr = c.Address
            Do
                If FindSomeText Is Nothing Then
                    Set FindSomeText = c
                Else
                    Set FindSomeText = Application.Union(FindSomeText, c)
                End If
                Set c = argRng.FindNext(c)
            Loop While Not c Is Nothing And c.Address <> StartAddr
        End If
    End If
End Function

That works ! but i only want to search in the column "Tags" (G2 downward). what can be changed on your code ? Thanks

 

[Fredoub20]

also how can you reset it ? like to see all the rows

 

[GWteB]

That works ! but i only want to search in the column "Tags" (G2 downward). what can be changed on your code ? Thanks

I see, replace this line within the CustomSearch procedure

        Set Rng = .Range("A3", Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count))

with this one

        Set Rng = .Range("G3:G" & .Cells(.Rows.Count, "G").End(xlUp).Row)

also how can you reset it ? like to see all the rows

Thought you already had a macro for that. Nevertheless, it can be done by having no search arguments at all when the CustomSearch is invoked, or with this macro

Public Sub Reset()
    Dim Sht As Worksheet
    Set Sht = ThisWorkbook.Worksheets("Sheet1")     ' <<< change sheet name to suit
    Sht.Cells.EntireRow.Hidden = False
End Sub