Consulting

Results 1 to 12 of 12

Thread: Combine 2 ranges, compare and take the unique values

  1. #1
    VBAX Mentor
    Joined
    Nov 2020
    Location
    Cochin, Kerala
    Posts
    314
    Location

    Combine 2 ranges, compare and take the unique values

    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
    Attached Files Attached Files

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,743
    Location
    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
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    VBAX Mentor
    Joined
    Nov 2020
    Location
    Cochin, Kerala
    Posts
    314
    Location
    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,
    Last edited by anish.ms; 10-23-2023 at 09:24 PM.

  4. #4
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    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
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2405, Build 17628.20102

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

  6. #6
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,743
    Location
    Quote Originally Posted by anish.ms View Post
    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?





    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  7. #7
    VBAX Mentor
    Joined
    Nov 2020
    Location
    Cochin, Kerala
    Posts
    314
    Location
    Thanks a lot georgiboy
    This is working fine.

  8. #8
    VBAX Mentor
    Joined
    Nov 2020
    Location
    Cochin, Kerala
    Posts
    314
    Location
    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

  9. #9
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    Quote Originally Posted by anish.ms View Post
    Thanks a lot georgiboy
    This is working fine.
    You are welcome, thanks for the feedback.
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2405, Build 17628.20102

  10. #10
    VBAX Mentor
    Joined
    Nov 2020
    Location
    Cochin, Kerala
    Posts
    314
    Location
    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
    Attached Files Attached Files

  11. #11
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,244
    Location
    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
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2405, Build 17628.20102

  12. #12
    VBAX Mentor
    Joined
    Nov 2020
    Location
    Cochin, Kerala
    Posts
    314
    Location
    Thanks a lot georgiboy

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •