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
:hi:

[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 :bow: