Combine 2 ranges, compare and take the unique values

[anish.ms]

Dear Experts,
Request your support on the below where I was trying to figure out the issue with the code and could not succeed.

Attached the sample file where I wanted to combine the values in column A & B in both the sheets and compare and take the unique values from column F of Sheet("Detailed") to column F of Sheet("Summary").

Sheet("Detailed") - Invoice numbers repeating with either same and/or different rejection remarks.
Sheet("Summary")- Pivoted by CompanyName and InvoiceNumber

I have done it using the filter formula in column G of Sheet("Summary"). But I wanted the same to be done using the VBA code and seeking help in correcting and guiding what I'm doing wrong.

Thanks,

Sub Check()
    Dim Sh1    As Worksheet, Sh2 As Worksheet
    Dim Sh1_LR As Long, Sh2_LR As Long, x As Long, y As Long
    Dim rng1, rng2, rng3
    Dim dict
    Dim rngResults As Range
        
    Set Sh1 = Sheets("Summary")
    Set Sh2 = Sheets("Detailed")
    Sh1_LR = Sh1.UsedRange.Rows.Count
    Sh2_LR = Sh2.UsedRange.Rows.Count
    
    Set rngResults = Sh1.Range("F2:F" & Sh1_LR)
    ReDim Results(1 To Sh1_LR - 1, 1 To 1)
    rng1 = Sh1.Range("A2:A" & Sh1_LR).Value & Sh1.Range("B2:B" & Sh1_LR).Value
    rng2 = Sh2.Range("A2:A" & Sh2_LR).Value & Sh2.Range("B2:B" & Sh2_LR).Value
    rng3 = Sh2.Range("F2:F" & Sh2_LR).Value
    
    Set dict = CreateObject("Scripting.Dictionary")
    For x = 1 To UBound(rng1)
        dict.RemoveAll
        For y = 1 To UBound(rng2)
            If rng1(x) = rng2(y) Then
                dict(rng3(y, 1)) = 0
            End If
        Next y
        If dict.Count > 0 Then Results(x, 1) = Join(dict.keys, " | ")
    Next x
    rngResults.Value = Results
    Erase rng1, rng2, Results
        
    MsgBox "DONE"
End Sub

[Paul_Hossler]

Renamed some variables so I could keep them straight, but try this

I'm not sure what you meant by 'unique' so right now it only uses the F in the first A+B that it finds

Option Explicit


Sub Check()
    Dim wsSummary As Worksheet, wsDetailed As Worksheet
    Dim rowSummary As Range, rowDetailed As Range
    Dim dict As Object
    
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    
    Set wsSummary = Sheets("Summary")
    Set wsDetailed = Sheets("Detailed")
    
    
    Set dict = CreateObject("Scripting.Dictionary")
    dict.RemoveAll
    dict.Comparemode = vbTextCompare
    
    For Each rowDetailed In wsDetailed.Cells(1, 1).CurrentRegion.Rows
        With rowDetailed
            If .Row > 1 Then
                If Not dict.Exists(.Cells(1, 1).Value & "#" & .Cells(1, 2).Value) Then
                    Application.StatusBar = "Building Dictionary, row = " & .Row
                    Call dict.Add(.Cells(1, 1).Value & "#" & .Cells(1, 2).Value, .Cells(1, 6).Value)
                End If
            End If
        End With
    Next


    For Each rowSummary In wsSummary.Cells(1, 1).CurrentRegion.Rows
        With rowSummary
            If .Row > 1 Then
                If dict.Exists(.Cells(1, 1).Value & "#" & .Cells(1, 2).Value) Then
                    Application.StatusBar = "Updating Summary, row = " & .Row
                    .Cells(1, 6).Value = dict(.Cells(1, 1).Value & "#" & .Cells(1, 2).Value)
                End If
            End If
        End With
    Next
    
    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
    
    MsgBox "DONE"
End Sub

[anish.ms]

Thanks Paul!

By unique I meant the Unique worksheet function in excel.
I wanted all the values from F for very match of A&B and then remove duplicates and take the unique list.
For example, row number 24 - INS1 & 1226953 has 2 unique values in column F in sheet("Detailed")
similarly, row number 573 INS3 & 80257 has 4 unique values.

Hope I have explained better what I was looking for.
Thanks,

[georgiboy]

You could EVALUATE your current formula and output the array:

Sub test()
    Dim var As Variant
    Dim wsSum As Worksheet, wsDet As Worksheet
    Dim lrSum As Long, lrDet As Long
    Dim SumAB As String, DetF As String, DetA As String, DetB As String
    
    Set wsSum = Sheets("Summary")
    Set wsDet = Sheets("Detailed")
    
    lrSum = wsSum.Range("A" & Rows.Count).End(xlUp).Row
    lrDet = wsDet.Range("A" & Rows.Count).End(xlUp).Row
    
    SumAB = wsSum.Range("A2:B" & lrSum).Address(, , , 1)
    DetF = wsDet.Range("F2:F" & lrDet).Address(, , , 1)
    DetA = wsDet.Range("A2:A" & lrDet).Address(, , , 1)
    DetB = wsDet.Range("B2:B" & lrDet).Address(, , , 1)
    
    var = Evaluate("BYROW(" & SumAB & ",LAMBDA(x,TEXTJOIN("" | "",TRUE,UNIQUE(FILTER(" & DetF & ",(" & DetA & "=INDEX(x,,1))*(" & DetB & "=INDEX(x,,2)))))))")
    wsSum.Range("F2:F" & lrSum) = var
End Sub

[parttime_guy]

Hi All
Just wanted to help.....
Solution attached
Its very OLD fashioned - But WORKS

[Paul_Hossler]

Thanks Paul!

By unique I meant the Unique worksheet function in excel.
I wanted all the values from F for very match of A&B and then remove duplicates and take the unique list.
For example, row number 24 - INS1 & 1226953 has 2 unique values in column F in sheet("Detailed")
similarly, row number 573 INS3 & 80257 has 4 unique values.

Hope I have explained better what I was looking for.
Thanks,

So for INS1 & 1226953 you want the 2 unique values from in column F in sheet("Detailed") making 2 lines on Summary and for 573 INS3 & 80257 you want 4 lines on Summary


OR


for INS1 & 1226953 you want the 2 unique values from in column F in sheet("Detailed") joined making 1 longer line on Summary?

[anish.ms]

Thanks a lot georgiboy
This is working fine.

[anish.ms]

Thanks Paul,
The second option.
INS1 & 1226953 - 2 unique values from in column F in sheet("Detailed") joined making 1 longer line on Summary.
Summary sheet is actually a pivot from the detailed sheet

[georgiboy]

Thanks a lot georgiboy
This is working fine.

You are welcome, thanks for the feedback.

[anish.ms]

Hi,
One more ask on the same file.
The data in the sheet is copied from multiple files by looping though the files in a folder. Here, I have an issue with the date format in some of the cells which I'm able to correct by selecting the column and find by "/" and replace by "/". However, the same is not working in VBA using the following code.
What could be the reason?

Sub correctdates()
    With ThisWorkbook.Sheets("RA Detailed")
        .Range("C2:C" & .UsedRange.Rows.Count).Replace What:="/", Replacement:="/", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=True, FormulaVersion:=xlReplaceFormula2
    End With
End Sub

[georgiboy]

Perhaps the below will help:

Sub correctdates()
    Dim dRng As Range
    Dim var As Variant
    Dim x As Long
    
    Set dRng = Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row)
    var = dRng.Value
    
    For x = 1 To UBound(var)
        var(x, 1) = CDate(var(x, 1))
    Next x
    dRng = var
End Sub

[anish.ms]

Thanks a lot georgiboy