Combine two records into one based on a different tab

[SpunkyElderBerry]

Hello,

I'm in the process of expanding on a macro to look at customer ID and the product name they ordered. If they ordered a set of a particular product then it will combine both product name into one and delete the oldest record.




I have created another tab that combines the product name condensed based on the following

[TABLE="class: outer_border, width: 500"]
<tbody>[TR]
[TD]Test 1[/TD]
[TD]Test 2[/TD]
[TD]Test To use[/TD]
[/TR]
[TR]
[TD]ABC123[/TD]
[TD]ABC456[/TD]
[TD]ABC123456[/TD]
[/TR]
[TR]
[TD]PEN541[/TD]
[TD]PENV2[/TD]
[TD]PEN541V2

[/TD]
[/TR]
</tbody>[/TABLE]



For example here is a small list of customers that has two products. Based on the table above if a customer has test 1 and test 2 then it should be combine into "Test to use".
[TABLE="class: outer_border, width: 500"]
<tbody>[TR]
[TD]Record #[/TD]
[TD]Customer Name[/TD]
[TD]Product Name[/TD]
[TD]Product Name Condensed[/TD]
[/TR]
[TR]
[TD]101[/TD]
[TD]James Smith[/TD]
[TD]ABC-123[/TD]
[TD]ABC123[/TD]
[/TR]
[TR]
[TD]101[/TD]
[TD]James Smith[/TD]
[TD]ABC-456[/TD]
[TD]ABC456[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]202[/TD]
[TD]Jill Jones[/TD]
[TD]PEN-541[/TD]
[TD]PEN541[/TD]
[/TR]
[TR]
[TD]202[/TD]
[TD]Jill Jones[/TD]
[TD]PEN-V2[/TD]
[TD]PENV2[/TD]
[/TR]
</tbody>[/TABLE]

The output of the macro should be the following:
[TABLE="width: 500"]
<tbody>[TR]
[TD]Record #[/TD]
[TD]Customer Name[/TD]
[TD]Product Name[/TD]
[TD]Product Name Condensed[/TD]
[/TR]
[TR]
[TD]101[/TD]
[TD]James Smith[/TD]
[TD]ABC123456[/TD]
[TD]ABC123456[/TD]
[/TR]
[TR]
[TD]202[/TD]
[TD]Jill Jones[/TD]
[TD]PEN541V2[/TD]
[TD]PEN541V2[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]




Here if the code i been using thus far

Sub DupTestDelete()
'
' MaskDuplicateTests Macro
'
' Keyboard Shortcut: Ctrl+Shift+A
'
Sheets("Tests").Activate
For i = 2 To Sheets.Count
    pickTest.ComboBox1.AddItem Sheets(i).Name
Next i
pickTest.Show
End Sub


Sub MaskDuplicateTests(pickedTest As String)


screenUpdateState = Application.ScreenUpdating
statusBarState = Application.DisplayStatusBar
calcState = Application.Calculation
eventsState = Application.EnableEvents
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Dim acc As Long
acc = Cells.Find(What:="Record #", LookIn:=xlFormulas, LookAt:= _
       xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
       , SearchFormat:=False).Column
Dim patID As Long
patID = Cells.Find(What:="Customer ID", LookIn:=xlFormulas, LookAt:= _
       xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
       , SearchFormat:=False).Column
Dim TestName As Long
TestName = Cells.Find(What:="Product Name", LookIn:=xlFormulas, LookAt:= _
       xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
       , SearchFormat:=False).Column
Dim TestNameCon As Long
TestNameCon = Cells.Find(What:="Product Name Condensed", LookIn:=xlFormulas, LookAt:= _
       xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
       , SearchFormat:=False).Column
If TestName = TestNameCon Then
    TestName = Cells.Find(What:="Test Name", LookIn:=xlFormulas, LookAt:= _
       xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
       , SearchFormat:=False).Column
End If
Dim x As Long
Dim y As Long
Dim firstTest As String
Dim secondTest As String
x = 2
Do While Sheets("Tests").Cells(x, 1).Value <> ""
    If Sheets("Tests").Cells(x, patID).Value = Sheets("Tests").Cells(x + 1, patID).Value Then
        firstTest = LCase(Trim(Sheets("Tests").Cells(x, TestNameCon).Text))
        secondTest = LCase(Trim(Sheets("Tests").Cells(x + 1, TestNameCon).Text))
        If firstTest = secondTest Then
            If Sheets("Tests").Cells(x, acc).Value > Sheets("Tests").Cells(x + 1, acc).Value Then
                Sheets("Tests").Rows(x + 1).Delete
            ElseIf Sheets("Tests").Cells(x, acc).Value < Sheets("Tests").Cells(x + 1, acc).Value Then
                Sheets("Tests").Rows(x).Delete
            Else
                If InStr(LCase(Sheets("Tests").Cells(x, TestName).Text), "step2") > 0 Then
                    Sheets("Tests").Rows(x + 1).Delete
                ElseIf InStr(LCase(Sheets("Tests").Cells(x + 1, TestName).Text), "step2") > 0 Then
                    Sheets("Tests").Rows(x).Delete
                Else
                    x = x + 1
                End If
            End If
            GoTo vbaNeedsContinueStatements
        End If
        y = 2
        Do While Sheets(pickedTest).Cells(y, 1).Value <> ""
            If LCase(Trim(Sheets(pickedTest).Cells(y, 1).Text)) = firstTest Then
                If LCase(Trim(Sheets(pickedTest).Cells(y, 2).Text)) = secondTest Or LCase(Trim(Sheets(pickedTest).Cells(y, 2).Text)) = "anything" Then
                    If LCase(Trim(Sheets(pickedTest).Cells(y, 3).Text)) = "both" Then
                    ElseIf LCase(Trim(Sheets(pickedTest).Cells(y, 3).Text)) = firstTest Then
                        Sheets("Tests").Rows(x + 1).Delete
                        x = x - 1
                    Else
                        Sheets("Tests").Rows(x).Delete
                        x = x - 1
                    End If
                    Exit Do
                End If
            ElseIf LCase(Trim(Sheets(pickedTest).Cells(y, 1).Text)) = secondTest Then
                If LCase(Trim(Sheets(pickedTest).Cells(y, 2).Text)) = firstTest Or LCase(Trim(Sheets(pickedTest).Cells(y, 2).Text)) = "anything" Then
                    If LCase(Trim(Sheets(pickedTest).Cells(y, 3).Text)) = "both" Then
                    ElseIf LCase(Trim(Sheets(pickedTest).Cells(y, 3).Text)) = firstTest Then
                        Sheets("Tests").Rows(x + 1).Delete
                        x = x - 1
                    Else
                        Sheets("Tests").Rows(x).Delete
                        x = x - 1
                    End If
                    Exit Do
                End If
            End If
            y = y + 1
        Loop
    End If
    x = x + 1
vbaNeedsContinueStatements:
Loop
Application.ScreenUpdating = screenUpdateState
Application.DisplayStatusBar = statusBarState
Application.Calculation = calcState
Application.EnableEvents = eventsState
End Sub

Any help would be much appreciated. Thanks in advanced!