Search code examples
excelvbaloopsfor-loopdatatable

Replace values ​that contain a specific word in VBA

I have a table like this

Header1 Header2
First asastr2b
Second caxstr1c
First strnnn3d
Second xmkjl3a
First xlkjlm2

I want to replace for the Header2 all cells that contains the string "str" for other value, for example "Replaced" So finally i would have something like this

Header1 Header2
First Replaced
Second Replaced
First Replaced
Second xmkjl3a
First xlkjlm2

for now i have this code, but is too slow, so if someone has something better for this case pls help. Thx!

Sub Macro1()
'
'
' filters and Replaces in the Header2 those cells that contain  str by Replaced

'Filter

Sheets("TESTS").Select #TESTS is the name of sheet
Range("TESTS[[#Headers],[Header2]]").Select
ActiveSheet.ListObjects("TESTS").Range.AutoFilter Field:=2, _
Criteria1:="=*str*" 'filter cells that contain "str"

'Change the cells
ActiveSheet.Range("B1").Select  'Header2 is in column B1
For Each cell In Columns(2).SpecialCells(xlCellTypeVisible)
cell.Replace What:="=*str*", Replacement:="Replaced", LookAt:=xlPart
Next
Range(Selection, Selection.End(xlDown)).Select
Selection.Value = "Replaced"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Header2"  'to rename header

End Sub
Solution

  • Maybe like this (avoiding cell-by-cell updates)

    Sub Macro1()

    Dim lo As ListObject, lc As ListColumn, arr, r As Long
    
    Set lo = ThisWorkbook.Worksheets("TESTS").ListObjects("TESTS")
    Set lc = lo.ListColumns("Header2")
    
    arr = lc.DataBodyRange.Value   'read all data to an array
    
    For r = 1 To UBound(arr, 1)
        If arr(r, 1) Like "*str*" Then arr(r, 1) = "Replaced"
    Next r
    
    lc.DataBodyRange.Value = arr   'write back modified array
    
End Sub