Search code examples
arraysexcelvbacell

Excel find & replace cell contents based on contents of a list in another sheet


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.


Solution

  • 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.