How to match columns and count the matches using vba

Question

I am working on one scenario where I have two sheets. Sheet1 is the master sheet and sheet2 which I am creating.

Column1 of Sheet1 is Object which has duplicate objects as well. So, what I have done is I have created a macro which will produce the unique Objects and will paste it in sheet2.

Now, from Sheet2, each of the objects should be matched with Sheet1 column1 and based on the matching results, it should also count the corresponding entries from other columns in sheet1 to sheet2.

Below are the snapshots of my two sheets

Sheet1

Sheet2

here is my macro code which will first copy and paste the unique objects from sheet1 to sheet2 Column1.

Sub UniqueObj()
Dim Sh1 As Worksheet
    Dim Rng As Range
    Dim Sh2 As Worksheet
    Set Sh1 = Worksheets("Sheet1")
    Set Rng = Sh1.Range("A1:A" & Sh1.Range("A65536").End(xlUp).Row)
    Set Sh2 = Worksheets("Sheet1")
    Rng.Cells(1, 1).Copy Sh2.Cells(1, 1)
    Rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sh2.Range("A1"), Unique:=True
    
End Sub

But, I am unable to move forward from there. I am pretty new and any help would be very greatful.

Thanks

Sorry for not sticking with VBA, but since you work with Excel why not use PowerQuery and run merge operations to retrieve any data you want from matched items? — Oskar_U
this sheet has other macros as well. So to maintain the uniformity and ease for the users — 2437850
You could still have clearly described data operations on PQ and in worst-case-scenario refresh it via VBA xD. Irregardless to PQ I would suggest to keep the data in Sheet1 as table object, therefore you're able to access the data with dedicated methods and later on easily deduplicate "Object" column. Later on you could utilize countifs formulas on sheet2 and just swap formulas to values with VBA. — Oskar_U

barvobot barvobot · Accepted Answer · 2020-10-20T19:58:23

If I'm understanding what you want correctly, you're just counting matching columns from Sheet1 where the value in the corresponding column isn't blank? If so this should do the trick.

Option Explicit

Sub GetStuffFromSheet1()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastRow1 As Long, lastRow2 As Long
Dim x As Long

'turn on error handling
On Error GoTo error_handler

Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")

'determine last row with data in sheet 1
lastRow1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row

'determine last row with data in sheet 2
lastRow2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row

'define columns in sheet 1
Const objCol1 As Long = 1
Const rProdCol1 As Long = 3
Const keysCol1 As Long = 4
Const addKeysCol1 As Long = 5

'define columns in sheet 2
Const objCol2 As Long = 1
Const rProdCol2 As Long = 2
Const keysCol2 As Long = 3
Const addKeysCol2 As Long = 4

'turn off screen updating + calculation for speed
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'loop through all rows of sheet 2
For x = 2 To lastRow2
    
    'formula counts # of cells with matching obj where value isn't blank
    ws2.Cells(x, rProdCol2) = WorksheetFunction.CountIfs(ws1.Columns(objCol1), ws2.Cells(x, objCol2), ws1.Columns(rProdCol1), "<>" & "")
    ws2.Cells(x, keysCol2) = WorksheetFunction.CountIfs(ws1.Columns(objCol1), ws2.Cells(x, objCol2), ws1.Columns(keysCol1), "<>" & "")
    ws2.Cells(x, addKeysCol2) = WorksheetFunction.CountIfs(ws1.Columns(objCol1), ws2.Cells(x, objCol2), ws1.Columns(addKeysCol1), "<>" & "")
    
Next x

'turn screen updating + calculation back on
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Exit Sub

error_handler:

'display error message
MsgBox "Error # " & Err.Number & " - " & Err.Description, vbCritical, "Error"

'turn screen updating + calculation back on
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Exit Sub

End Sub

How to match columns and count the matches using vba

2 Answers