Excel find & replace cell contents based on conten

Question

Possible Duplicate:
Excel clear cells based on contents of a list in another sheet

On Excel clear cells based on contents of a list in another sheet bonCodigo helped me with a VBA macro script that has column and row ranges specified to take the words from A column of Sheet1, then find them as an exact match in Sheet2 columns to get found ones cleaned. Results get generated in Sheet3.

This is the VBA code that does that:

Sub matchAndClear()
Dim ws As Worksheet
Dim arrKeys As Variant, arrData As Variant
Dim i As Integer, j As Integer, k As Integer

'-- here we take keys column from Sheet 1 into a 1D array
arrKeys = WorksheetFunction.Transpose(Sheets(1).Range("A1:A38").Value)
'-- here we take to be cleaned-up-range from Sheet 2 into a 2D array
arrData = WorksheetFunction.Transpose(Sheets(2).Range("A1:I100").Value)

'-- here we iterate through each key in keys array searching it in
'-- to-be-cleaned-up array
For i = LBound(arrKeys) To UBound(arrKeys)
    For j = LBound(arrData, 2) To UBound(arrData, 2)
            '-- when there's a match we clear up that element
            If UCase(Trim(arrData(1, j))) = UCase(Trim(arrKeys(i))) Then
                arrData(1, j) = " "
            End If
            '-- when there's a match we clear up that element
            If UCase(Trim(arrData(2, j))) = UCase(Trim(arrKeys(i))) Then
                arrData(2, j) = " "
            End If
    Next j
Next i

'-- replace old data with new data in the sheet 2 :)
Sheets(3).Range("A1").Offset(0, 0).Resize(UBound(arrData, 2), _
UBound(arrData)) = Application.Transpose(arrData)

End Sub

This time I need help with a slightly different VBA. In Sheet1 B columnt here is another list of words, so the VBA should not find and clear the cells contents matching wordlist values found on Sheet1 A column, but replace the found values (exact match is needed) with the ones from Sheet1 B column.

Answer 1

If I understood the input correctly, the below code will find "ac" from Sheet1!A1 and replace it to "hertha" from Sheet1!B1:

Sub MatchAndReplace()
    Dim ws As Worksheet
    Dim arrKeysA As Variant, arrKeysB As Variant, arrData As Variant
    Dim i As Integer, j As Integer, k As Integer

    '-- here we take keys column A from Sheet 1 into a 1D array
    arrKeysA = WorksheetFunction.Transpose(Sheets(1).Range("A1:A38").Value)
    '-- here we take keys column B from Sheet 1 into a 1D array
    arrKeysB = WorksheetFunction.Transpose(Sheets(1).Range("B1:B38").Value)
    '-- here we take to be replaced range from Sheet 2 into a 2D array
    arrData = WorksheetFunction.Transpose(Sheets(2).Range("A1:I100").Value)

    '-- here we iterate through each key in keys array searching it in
    '-- to-be-replaced array
    For i = LBound(arrKeysA) To UBound(arrKeysA)
        For j = LBound(arrData, 2) To UBound(arrData, 2)
                '-- when there's a match we replace that element
                If UCase(Trim(arrData(1, j))) = UCase(Trim(arrKeysA(i))) Then
                    arrData(1, j) = Trim(arrKeysB(i))
                End If
                '-- when there's a match we replace that element
                If UCase(Trim(arrData(2, j))) = UCase(Trim(arrKeysA(i))) Then
                    arrData(2, j) = Trim(arrKeysB(i))
                End If
        Next j
    Next i

    '-- put new data on the sheet 3
    Sheets(3).Range("A1").Offset(0, 0).Resize(UBound(arrData, 2), _
    UBound(arrData)) = Application.Transpose(arrData)

End Sub

Here is the resulting Excel book with macro results on Sheet3: https://www.dropbox.com/s/i8ya0u7j6tjee13/MatchAndReplace.xls

Please respond in case something is not as expected.