Autofilter criteria to fill data in cells

[adnan1975]

Hello,
I am trying to use autofilter criteria to find cells with particular text and based on that trying to fill in cells in Col AC. I have come up with the following code but it is not working the way I expect it to. It runs and insert "RELEVANT TEXT HERE" but not in column AC and also not in the corresponding cells which meets the filter criteria.
I have another code to do the same which loops through each cell but it takes awfully long because my spreadsheet has over 10000 rows. I am hoping to use autofilter to speed up my code.

I am not good with VBA and dont know what am I not doing correctly here. Any help is very much appreciated.
Thanks

Sub amt_with_Autofilter()


    Dim rng As Range
    Dim Report As Worksheet
    Dim lr as long 

Set Report = ThisWorkbook.Sheets("Report")

    
lr = Report.Cells(Rows.Count, 4).End(xlUp).Row

    With Report
        'Firstly, remove the AutoFilter
        .AutoFilterMode = False

        'Apply the filter
        
        .Range("D8:D" & .Rows.Count).AutoFilter field:=1, Criteria1:="*TESTCASE*"

        With .AutoFilter.Range
            On Error Resume Next
                  Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
                    
            If Not rng Is Nothing Then .Range("AC9:AC" & lr).Value = "RELEVANT TEXT HERE"
        End With

        'Remove the AutoFilter
        Report.AutoFilterMode = False
         On Error Resume Next
    End With
 
 
End Sub

 

[DanteAmor]

Try this, With 10,000 records the response is immediate.

Sub ChangeRelevant()
  Dim report As Worksheet
  Dim a As Variant, b As Variant, i As Long, lr As Long
  
  Set report = Sheets("Report")
  With report
    lr = .Range("D" & Rows.Count).End(3).Row
    a = .Range("D9:D" & lr).Value2
    b = .Range("AC9:AC" & lr).Value2
    For i = 1 To UBound(a)
      If UCase(a(i, 1)) Like "*TESTCASE*" Then b(i, 1) = "RELEVANT TEXT HERE"
    Next
    .Range("AC9").Resize(UBound(b)).Value = b
  End With
End Sub

 

[Fluff]

How about

    With Report
        'Firstly, remove the AutoFilter
        .AutoFilterMode = False

        'Apply the filter
        
        .Range("D8:D" & .Rows.Count).AutoFilter field:=1, Criteria1:="*TESTCASE*"

        With .AutoFilter.Range
            .Offset(1, 25).Resize(.Rows.Count - 1, 1).Value = "Relevant text here"
        End With

        'Remove the AutoFilter
        .AutoFilterMode = False
    End With

 

[adnan1975]

Try this, With 10,000 records the response is immediate.

Sub ChangeRelevant()
  Dim report As Worksheet
  Dim a As Variant, b As Variant, i As Long, lr As Long
 
  Set report = Sheets("Report")
  With report
    lr = .Range("D" & Rows.Count).End(3).Row
    a = .Range("D9:D" & lr).Value2
    b = .Range("AC9:AC" & lr).Value2
    For i = 1 To UBound(a)
      If UCase(a(i, 1)) Like "*TESTCASE*" Then b(i, 1) = "RELEVANT TEXT HERE"
    Next
    .Range("AC9").Resize(UBound(b)).Value = b
  End With
End Sub

Thanks for your help.
it works. the only question I have is about UCase. What if I want to remove any upper or lower case issues?

 

[adnan1975]

How about

    With Report
        'Firstly, remove the AutoFilter
        .AutoFilterMode = False

        'Apply the filter
       
        .Range("D8:D" & .Rows.Count).AutoFilter field:=1, Criteria1:="*TESTCASE*"

        With .AutoFilter.Range
            .Offset(1, 25).Resize(.Rows.Count - 1, 1).Value = "Relevant text here"
        End With

        'Remove the AutoFilter
        .AutoFilterMode = False
    End With

Thank you very much. it works well. much appreciated.

 

[DanteAmor]

Thanks for your help.
it works. the only question I have is about UCase. What if I want to remove any upper or lower case issues?

You want it to be case sensitive, so change UCase(a(i, 1)) to a(i, 1)

 

[Fluff]

Glad we could help & thanks for the feedback.

 

[adnan1975]

You want it to be case sensitive, so change UCase(a(i, 1)) to a(i, 1)

One question, is your code based on Arrays? or how it works? I tried the similar code using cells as variables and looping through cells. It does the work but takes the macro to run for more than 10 min to resolve. My code looks like this:

With RP

For Each cell In .Range("AR")

Set Offsetrng1 = cell.Offset(, 25)
Set Offsetrng2 = cell.Offset(, 28)

'/////////////////////////////////////////with reference from Title (Action Reference)/////////////////////////////////////////////
'NW District AMT and RARS
If cell.Value Like "*YYYY*" Then
        Offsetrng1.Value = "xxxx District"
        Offsetrng2.Value = "TEXT 1 HERE"
    ElseIf cell.Value Like "*ABCD*" Then
        Offsetrng1.Value = "xxxx District"
        Offsetrng2.Value = "TEXT 2 HERE"

I have been trying to speed up my code but couldn't figure it out. I think looping through each cell was something I should have avoid. The solution you provided is perfect and runs very quickly.
As someone who is not good with programming, I continue to learn and improve my VBA coding skills
Again, always appreciate the support I get on this forum. Thank you very much for all the help. ?

 

[DanteAmor]

is your code based on Arrays?

Yes it is.

The process is done in memory, so it is faster.
Doing operations with cells is slower.
If you explain what you need here, I could adapt the code.
If it's a new topic, you should create a new thread.

 

[adnan1975]

Yes it is.

The process is done in memory, so it is faster.
Doing operations with cells is slower.
If you explain what you need here, I could adapt the code.
If it's a new topic, you should create a new thread.

I am good. the code you provided works just fine for me. I will try to modify my other codes to arrays as well rather than using cells property. I just need to learn more about the arrays.