Sum values with like reference numbers

[VBAdude]

Hello,

Here is sample of my data set (values in column A and Ref numbers in column B):


7.00 H1234
-700 H1234
8.00 H1234
-8.00 H1234
9.00 S456
10.00 S456
6.00 T2345
-6.00 T2345

In this example, if the sum of all values = 0 for each identical set of ref numbers, hi-light all similar cells a color in column B.

So, Column B should have the following cells hi-lighted: B1:B4 and B7:B8 as the sum equals zero in those groups.

I'm not interested in sub-totals or pivot tbls for this....I'd really like to learn the VBA code..

Thanks in advance!

 

[mikerickson]

There's no need for VBA.
Conditional formatting with the formula =(SUMIF(B:B,B1,A:A)=0) will do what you want.

 

[Zaf]

This should work

Option Explicit
Option Base 1
Public Sub Highlight_Cells()
Dim i, j, k As Long
Range("A1").Select
Selection.CurrentRegion.Select
Dim r, c As Long
r = Selection.Rows.Count
c = Selection.Columns.Count
Range("A1").Select
Dim Data() As Variant
ReDim Data(r, c)
For i = 1 To r
For j = 1 To c
Data(i, j) = ActiveCell.Offset(i - 1, j - 1).Value
    If Data(i, j) = "" Then
    MsgBox ("The data set has missing values...")
    End If
Next j
Next i
'==============================================
'Get all unique instances of names in column B
Dim Flag As Boolean 'Boolean Flag
Dim Codes() As String
ReDim Codes(1)
Codes(1) = UCase(Trim(Data(1, 2)))
For i = 2 To r
Flag = False
    For j = 1 To UBound(Codes)
    If UCase(Trim(Codes(j))) = UCase(Trim(Data(i, 2))) Then
    'This code is already on the list...
    Flag = True
    End If
    Next j
If Flag = False Then
ReDim Preserve Codes(UBound(Codes) + 1)
Codes(UBound(Codes)) = UCase(Trim(Data(i, 2)))
End If
Next i
'==============================================
'Sum all values for a given code...
Dim ValSum() As Variant
ReDim ValSum(UBound(Codes), 2)
For i = 1 To UBound(Codes)
ValSum(i, 1) = Codes(i)
ValSum(i, 2) = 0
Next i
For i = 1 To UBound(Codes)
    For j = 1 To r
    If UCase(Trim(Data(j, 2))) = UCase(Trim(Codes(i))) Then
    ValSum(i, 2) = ValSum(i, 2) + Data(j, 1)
    End If
    Next j
Next i
'The array 'ValSum has the code name in the first column
'and the sum of these code values in the second...
For i = 1 To UBound(Codes)
Debug.Print (ValSum(i, 1) & " " & ValSum(i, 2))
Next i
'===========================================================
'Highlight the cells that sum to zero...
Range("B1").Select
Do While ActiveCell.Value <> ""
For i = 1 To UBound(Codes)
If UCase(Trim(ActiveCell.Value)) = ValSum(i, 1) Then 'Codes Match
If ValSum(i, 2) = 0 Then 'The sum is zero
'Highlight cell
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    
End If
End If
Next i
ActiveCell.Offset(1, 0).Select
Loop
Range("A1").Select
End Sub