Search code examples
excelvbaexcel-formulaexcel-2010

Bulk find and replace same values of in cells of a column


I am trying to create an Excel VBA function to search values of column A and find same cells in column H, and replace these cells in B2:F6 with values of J2:N4.

My Input File:

My Input File Format Image

Desired Output:

Desired Output Image

I have tried the following VBA code but it doesn't work. it finds and replace the values of column Replace1 and ignores Replace 2,3,... .

Sub MultiFindNReplace()
'Update 20140722
Dim Rng As Range
Dim InputRng As Range, ReplaceRng As Range
xTitleId = "KutoolsforExcel"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Original Range ", xTitleId, InputRng.Address, Type:=8)
Set ReplaceRng = Application.InputBox("Replace Range :", xTitleId, Type:=8)
Application.ScreenUpdating = False
For Each Rng In ReplaceRng.Columns(1).Cells
    InputRng.Replace what:=Rng.Value, replacement:=Rng.Offset(0, 1).Value
Next
Application.ScreenUpdating = True
End Sub

Solution

  • Looks like both datasets got same headers so you can benefit from that. If the headers are always the same and same sorting, just copy whole row:

    Sub test()
    'if headers of both datasets are always the same and sorted the same way, just copy whole row
    
    Dim rngDestiny As Range
    Dim rngSource As Range
    Dim rngFind As Range
    Dim rng As Range
    Dim i As Long
    Dim RowN As Long
    Dim LR As Long
    
    Set rngSource = Range("I2:M4")
    Set rngFind = Range("H2:H4")
    Set rngDestiny = Range("B2:F6")
    
    LR = Range("A" & Rows.Count).End(xlUp).Row 'last non-blank cell in column f-name
    
    For i = 2 To LR Step 1
        With Application.WorksheetFunction
        'check if the value of f-name exists in column FIND
            If .CountIf(rngFind, Range("A" & i).Value) > 0 Then
                'there is a match, get row number and copy
                RowN = .Match(Range("A" & i).Value, rngFind, 0)
                rngSource.Rows(RowN).Copy rngDestiny.Rows(i - 1) 'minus 1 because our first row of data starts with i=2!!!
            End If
        End With
    Next i
    
    Set rngSource = Nothing
    Set rngFind = Nothing
    Set rngDestiny = Nothing
    
    End Sub
    

    enter image description here