SHARE
TWEET

T4325_Compare Two Tables Extract Matching Items

YasserKhalil2019 Nov 17th, 2019 (edited) 96 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. https://excel-egy.com/forum/t4325
  2. ---------------------------------
  3.  
  4. Sub Compare_Two_Tables_Extract_Matching_Items()
  5.     Dim x, ws As Worksheet, sh As Worksheet, r As Long
  6.    
  7.     Application.ScreenUpdating = False
  8.         Set ws = ThisWorkbook.Worksheets(2)
  9.         Set sh = ThisWorkbook.Worksheets(1)
  10.            
  11.         With sh.Range("A2:D" & sh.Cells(Rows.Count, 1).End(xlUp).Row)
  12.             .Interior.Color = xlNone
  13.             .Columns(4).ClearContents
  14.         End With
  15.            
  16.         For r = 2 To ws.Cells(Rows.Count, 2).End(xlUp).Row
  17.             x = Application.Match(ws.Cells(r, 1).Value, sh.Columns(1), 0)
  18.                
  19.             If Not IsError(x) Then
  20.                 sh.Cells(x, 4).Value = ws.Cells(r, 3).Value
  21.                 sh.Cells(x, 1).Resize(1, 4).Interior.Color = vbCyan
  22.             End If
  23.         Next r
  24.     Application.ScreenUpdating = True
  25. End Sub
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top