Macro to count unique values in a column and compare with the count on a second sheet

[Aps]

Hi,

I need some help with the vba macro. I have 2 excel sheets A and B. Sheet B is a subset of sheet A. I want to count the unique values in column B on sheet A and do the same on sheet B. I then want to compare the count values in the 2 sheets and if there is a mismatch it should display the all columns in sheet A on sheet C.

Example:

Sheet A has the following records in column B
HVAC_PARTS_3500012
HVAC_PARTS_3500012
HVAC_PARTS_3500033
HVAC_PARTS_3500033
HVAC_PARTS_3500034
HVAC_PARTS_3500034

This should show the count as

HVAC_PARTS_3500012 2
HVAC_PARTS_3500033 2
HVAC_PARTS_3500034 2

Sheet B has the following records in column B

HVAC_PARTS_3500012
HVAC_PARTS_3500012
HVAC_PARTS_3500033
HVAC_PARTS_3500034
This should show the count as

HVAC_PARTS_3500012 2
HVAC_PARTS_3500033 1
HVAC_PARTS_3500034 1

Sheet C should show all columns from sheet A for column B value equal to the following

HVAC_PARTS_3500033
HVAC_PARTS_3500034

Thanks in advance for your help.

 

[Marc L]

Hi !

A VBA beginner should use an advanced filter to copy unique data
from a range and use an easy formula like COUNTIF …
​

 

[p45cal]

Try this in your sample sheet (it ONLY gives the table on sheet 3, not any counts):

Sub blah()
ShtARowCount = Sheets("Sheet A").Range("A1").CurrentRegion.Rows.Count
ShtBRowCount = Sheets("Sheet B").Range("A1").CurrentRegion.Rows.Count
With Sheets("Sheet C")
  Sheets("Sheet A").Range("B1:B" & ShtARowCount).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("G1"), Unique:=True
  'Sheets("Sheet B").Range("B1:B" & ShtBRowCount).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("G1"), Unique:=True
  Set extract = .Range("G1").CurrentRegion
  extract.Offset(, 2).FormulaR1C1 = "=IF(COUNTIF('Sheet A'!R1C2:R" & ShtARowCount & "C2,'Sheet C'!RC[-2])<>COUNTIF('Sheet B'!R1C2:R" & ShtBRowCount & "C2,'Sheet C'!RC[-2]),RC[-2],""z"")"
  .Range("I1").Value = .Range("G1").Value
  Sheets("Sheet A").Range("A1:E" & ShtARowCount).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=extract.Offset(, 2), CopyToRange:=.Range("A1:E1"), Unique:=False
  extract.Resize(, 3).Clear ' comment-out this line if you want to see the formulae used in the sheet, but YOU MUST reinstate it later.
End With
End Sub

It may need a little tweak:
I've commented out the line:

'Sheets("Sheet B").Range("B1:B" & ShtBRowCount).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("G1"), Unique:=True

It may be that in the real world you need to use this line instead of the line directly above it. With your data set it makes no difference which line you use, but…