Match partial cell values from different columns and copy

Question

I am trying to do a partial comparison between 2 columns from 2 different sheets in the same workbook.

For example: Sheet2's Column B contains the Rs ID(all numbers) and Column A contains Clinical Significance, in Sheet1 there are 2 columns A & B (contains strings and numbers) as well with the same headers.

If there is a partial match in Column B of Sheet2 with Column B of Sheet1, I will want my VBA code to copy the cell in Column A from Sheet2 to the same cell in in Column A in Sheet1.

Sheet1:

sheet1

Sheet2:

sheet2

This is my code. It runs perfectly but it doesnt seem to capture any data as the Column B in sheet2 is not exactly the same as Column A. Could it be I used the lookat:=xlPart incorrectly?

Sub test()
    Dim rng2 As Range, c2 As Range, cfind As Range
    Dim x, y
    With Worksheets("sheet1")
        Set rng2 = .Range(.Range("B2"), .Range("B2").End(xlDown))
        For Each c2 In rng2
            x = c2.Value
            With Worksheets("sheet2").Columns("B:B")
                On Error Resume Next
                Set cfind = .Cells.Find(what:=x, lookat:=xlPart, LookIn:=xlValues)
                If (Not (cfind Is Nothing)) Then
                    y = cfind.Offset(0, -1).Value
                    c2.Offset(0, -1) = y
                End If
            End With
        Next c2
    End With
End Sub

Not sure what you mean by partial match? can you be more specific as to what type of match it should be.. i.e. as long as the number in the sequence in sheet1-columnB are present in column in sheet2-columnB? or numbers to match exactly from sheet1-columnB to sheet2-columnB? — Zac

Wimpel Wimpel · Accepted Answer · 2017-11-02T09:47:23

You are (I believe) looking for the value from the first sheet, inside the second, while it should be the other way around ;-).

Try this, works for me with the data you provided. I use a slightly different approach, but the general idea stays the same.

Option Explicit


Sub test()

  'declaration
  Dim ws1 As Worksheet, ws2 As Worksheet
  Dim c1 As Range, c2 As Range, rng1 As Range, rng2 As Range, cfind As Range

  'set worksheets
  Set ws1 = ActiveWorkbook.Sheets(1)
  Set ws2 = ActiveWorkbook.Sheets(2)

  'define ranges to look in/for
  With ws1
    Set rng1 = .Range(.Cells(2, 2), .Cells(.Cells(Rows.Count, 2).End(xlUp).Row, 2))
  End With
  With ws2
    Set rng2 = .Range(.Cells(2, 2), .Cells(.Cells(Rows.Count, 2).End(xlUp).Row, 2))
  End With

  'loop through the values in sheet 1
  For Each c1 In rng1
    'loop through the values in sheets 2
    For Each c2 In rng2
      On Error Resume Next
      'look for the value from sheet 2, in sheet 1
      Set cfind = c1.Find(what:=c2.Value, lookat:=xlPart, LookIn:=xlValues)
      'is a partial match found? then copy the value from column sheet2-colA from c2 to sheet1-colA for c1
      If (Not (cfind Is Nothing)) Then
          c1.Offset(0, -1).Value = c2.Offset(0, -1).Value
      End If
      'emtpy the found range
      Set cfind = Nothing
    Next c2
  Next c1

'SUCCESS!!

End Sub

It always loops through all the values in rng2!! So if the value from c1 is found in multiple cells in rng2, then it overwrites the previous match with the latest find!

Match partial cell values from different columns and copy

1 Answers