Compare two columns and calculate sum

Closed
Shri - Mar 24, 2010 at 04:38 AM
venkat1926
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
- Mar 24, 2010 at 10:13 PM
Hi,

I have a table in one sheet and a column in another sheet something like as shown below

Table in Sheet 1
----------------------

Region1 |Region2 | Region3 |
-------------|------------|------------|
A1 | A2 | A3 |
B1 | B2 | B3 |
| C2 | C3 |
| D2 | E3 |

Column in Sheet 2
---------------------------

Region
---------
A2
B2
C3
D2
A2
E3
B2
A1
C2
A3
B1
B3
D2
A3
A1
C2
D2
E3

Now, i want to compare values of column 'Region1' with column 'Region in 2nd sheet and count the number of occurances of each values in column 'Region' and display the count in sheet 3.

Ex: A1 count is 2 and B1 count is 1 in sheet 2. So in sheet3 the count should be 2+1=3 for Region1.

Result Table
---------------

Count
--------------------------
Region1 3
Region2 9
Region3 6

Please anyone let me know how to do this in excel using formulas or macro's. Please help.

1 reply

venkat1926
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
805
Mar 24, 2010 at 10:13 PM
two macros are given . The operative macro is "test".
macro "undo" undoes the results of the macro
on the sample workbook run the macro "test"
if you want to recheck run "undo" and then run "test"
if it is ok you can use these macro in your original file

Sub test()
Dim r As Range, c As Range, x As String
Dim j As Integer, k As Integer, m As Integer
Dim r1 As Range, dest As Range
Dim reg As String
m = 0
Worksheets("sheet1").Activate
    j = Range("A1").End(xlToRight).Column
    For k = 1 To j
        With Columns(k)
        reg = Cells(1, k).Value
        Set r = Range(Cells(2, k), Cells(2, k).End(xlDown))
            'MsgBox r.Address
            For Each c In r
            x = Trim(c)
            With Worksheets("sheet2")
            Set r1 = Range(.Range("A2"), .Range("A2").End(xlDown))
            m = m + WorksheetFunction.CountIf(r1, x)
            End With
            Next c
            End With
With Worksheets("sheet3")
Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
dest = reg
dest.Offset(0, 1) = m
End With
m = 0
            Next k
Worksheets("sheet3").Activate
End Sub


Sub undo()
Worksheets("sheet3").Cells.Clear
End Sub
0