Macros for Matching Multiple Criteras

[khaos09]

Hi All,
I am new to this forum and looking for some assistance for creating a macro for a process that takes me about a day to complete. Any help would be greatly appreciated. And Thank you in advance!
Below is the table:

[TABLE="width: 500"]
<TBODY>[TR]
[TD]ProviderName
[/TD]
[TD]TotalCharge
[/TD]
[TD]DateOfService
[/TD]
[TD]Pairing
[/TD]
[/TR]
[TR]
[TD]John Smith
[/TD]
[TD]120.00
[/TD]
[TD]1/1/11
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Michael Dean
[/TD]
[TD]130.00
[/TD]
[TD]2/1/11
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]John Smith
[/TD]
[TD]60.00
[/TD]
[TD]1/1/11
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Michael Dean
[/TD]
[TD]50.00
[/TD]
[TD]2/1/11
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]John Smith
[/TD]
[TD]45
[/TD]
[TD]1/1/11
[/TD]
[TD][/TD]
[/TR]
</TBODY>[/TABLE]

What I currently do manually is look at the ProviderName and look for the names that matches, then I look at the DateOfService and look for the dates that matches. When those two criteria are met, I would add matching numbers to the column call Pairing. What I want the macro to do is automatically add the matching numbers for me in the Pairing Column. Below is the result.
[TABLE="width: 500"]
<TBODY>[TR]
[TD]ProviderName
[/TD]
[TD]TotalCharge
[/TD]
[TD]DateOfService
[/TD]
[TD]Pairing
[/TD]
[/TR]
[TR]
[TD]John Smith
[/TD]
[TD]120.00
[/TD]
[TD]1/1/11
[/TD]
[TD]1
[/TD]
[/TR]
[TR]
[TD]Michael Dean
[/TD]
[TD]130.00
[/TD]
[TD]2/1/11
[/TD]
[TD]2
[/TD]
[/TR]
[TR]
[TD]John Smith
[/TD]
[TD]60.00
[/TD]
[TD]1/1/11
[/TD]
[TD]1
[/TD]
[/TR]
[TR]
[TD]Michael Dean
[/TD]
[TD]50.00
[/TD]
[TD]2/1/11
[/TD]
[TD]2
[/TD]
[/TR]
[TR]
[TD]John Smith
[/TD]
[TD]45
[/TD]
[TD]1/1/11
[/TD]
[TD]1
[/TD]
[/TR]
</TBODY>[/TABLE]

 

[Jerry Sullivan]

Hi and Welcome to the Board,

You can do this with formulas instead of a macro.

For large datasets, it's best to add a helper column to concatentate the multiple criteria into a string.

Paste the formulas shown into D2 and E2 and then copy down.

Excel Workbook
	A	B	C	D	E
1	ProviderName	TotalCharge	DateOfService	Match Code	Pairing
2	John Smith	120	1/1/2011	John Smith|40544	1
3	Michael Dean	130	2/1/2011	Michael Dean|40575	2
4	John Smith	60	1/1/2011	John Smith|40544	1
5	Michael Dean	50	2/1/2011	Michael Dean|40575	2
6	John Smith	45	1/1/2011	John Smith|40544	1
Sheet

Also, this approach assumes that a single item that doesn't have any matches will stil be counted as a "pair" or better put, a unique combination.

 

[ZAX]

Hi khaos09,

this code works perfectly but it works only with Excel 2007 and Excel 2010 .
and by the way JS411, your method takes a lot of time to finish, whereas the code is faster and easier .

ZAX

Sub MULTIPLE_CRITERIA()
Dim COL As Range, Cell As Range
Set COL = Range("D2:D" & Right(ActiveCell.SpecialCells(xlCellTypeLastCell).Address(1, 0, xlA1), _
Len(ActiveCell.SpecialCells(xlCellTypeLastCell).Address(1, 0, xlA1)) - InStr(1, _
ActiveCell.SpecialCells(xlCellTypeLastCell).Address(1, 0, xlA1), "$")))
Range("D1").Formula = "PAIRS"
For Each Cell In COL
Cell.Select
ActiveCell.Formula = Application.CountIfs(Range("A:A"), _
Range("A" & Right(ActiveCell.Address(1, 0), Len(ActiveCell.Address(1, 0)) - InStr(1, _
ActiveCell.Address(1, 0), "$"))), _
Range("C:C"), Range("C" & Right(ActiveCell.Address(1, 0), _
Len(ActiveCell.Address(1, 0)) - InStr(1, ActiveCell.Address(1, 0), "$"))))
If Cell.Value = 0 Then Cell.Delete
Next Cell
Range("A1").Select
End Sub

 

[khaos09]

Thank you to both of you! This is awesome to know that there are very knowledgeable people out there that is willing to help others.

Zax,
I ran the code and it takes seconds to populate the "Pairing" field. What took me 8 hours to do, I am able to complete in seconds!

 

[Jerry Sullivan]

ZAX, Nice of you to offer a VBA approach. As much as l like VBA, sometimes it's helpful to offer a formula-based alternative when a problem can be solved with formulas.

khaos09, Did ZAX's VBA code provide the desired result? It looks like it provides a count of each unique combination instead of numbering them sequentiallly like your example.

Here is some code that does what's described in your original post...

Sub Label_Unique_Combinations()
    Dim lRow As Long
    
    Application.ScreenUpdating = False
 
    With ActiveSheet
        lRow = .Cells(Rows.Count, "A").End(xlUp).Row
        With .Range("D2:D" & lRow)
            .Offset(0, 1).FormulaR1C1 = "=RC1 &""|""&RC3"
            .FormulaR1C1 = "=IF(COUNTIF(R2C[1]:RC[1],RC[1])=1," _
                & "MAX(R1C:R[-1]C)+1,LOOKUP(RC[1],R2C[1]:RC[1],R2C:RC))"
            .Value = .Value
            .Offset(0, 1).ClearContents
        End With
    End With
    Application.ScreenUpdating = True
End Sub

 

[khaos09]

JS411,
I just analyzed the data using ZAX's code and you are correct it only provides the count. I went back to the excel and used your formula based logic and it worked well. I will try this new code out.

Thanks again!

 

[Jerry Sullivan]

Hi again khaos09,

Glad that you spotted that my formula was giving some incorrect results.
The Lookup function wasn't correct because the list is not sorted.
Here is code with a corrected formula using Index-Match.

Sub Label_Unique_Combinations()
    Dim lRow As Long
    
    Application.ScreenUpdating = False
 
    With ActiveSheet
        lRow = .Cells(Rows.Count, "A").End(xlUp).Row
        With .Range("D2:D" & lRow)
            .Offset(0, 1).FormulaR1C1 = "=RC1 &""|""&RC3"
            .FormulaR1C1 = "=IF(COUNTIF(R2C[1]:RC[1],RC[1])=1," _
                & "MAX(R1C:R[-1]C)+1,INDEX(R1C:R[-1]C,MATCH(RC[1],R1C[1]:R[-1]C[1],0)))"
            .Value = .Value
            .Offset(0, 1).ClearContents
        End With
    End With
    Application.ScreenUpdating = True
End Sub