VBA Unique data on Sheet3 from data on Sheet1 and Sheet2

Stephen_IV

Well-known Member
Joined
Mar 17, 2003
Messages
1,168
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
I am looking to take data from Sheet1 and Sheet2 and make a unique list on Sheet3. Please see below. Thanks in advance.

I have date that looks like this on Sheet1
Book1
AB
1IDAbsence
2111112/14/2018
3111112/24/2018
4111112/31/2018
511111/25/2019
611111/28/2019
711112/12/2019
Sheet1

Data on Sheet2
Book1
AB
1IDAbsence
2111112/14/2018
3111112/24/2018
4111112/31/2018
511111/25/2019
611111/28/2019
711112/13/2019
811112/14/2019
Sheet2

This is what I need on Sheet3
Book1
AB
1IDAbsence
2111110/22/2018
3111112/14/2018
4111112/24/2018
5111112/31/2018
611111/25/2019
711111/28/2019
811112/12/2019
911112/13/2019
1011112/14/2019
Sheet3
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Try this.

VBA Code:
Sub UNIQUE()
Dim ws1 As Worksheet: Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2")
Dim ws3 As Worksheet: Set ws3 = Sheets("Sheet3")
Dim res As Range: Set res = ws3.Range("A2")
Dim r1 As Range: Set r1 = ws1.Range("A2:B" & ws1.Range("A" & Rows.Count).End(xlUp).Row)
Dim r2 As Range: Set r2 = ws2.Range("A2:B" & ws2.Range("A" & Rows.Count).End(xlUp).Row)
Dim ar1() As Variant: ar1 = r1.Value
Dim ar2() As Variant: ar2 = r2.Value
Dim SD As Object: Set SD = CreateObject("Scripting.Dictionary")
Dim tmp As String

For i = 1 To UBound(ar1)
    tmp = Join(Array(ar1(i, 1), ar1(i, 2)), "-")
    If Not SD.exists(tmp) Then SD.Add tmp, Nothing
Next i

For j = 1 To UBound(ar2)
    tmp = Join(Array(ar2(j, 1), ar2(j, 2)), "-")
    If Not SD.exists(tmp) Then SD.Add tmp, Nothing
Next j

ws3.Range("A1:B1").Value = Array("ID", "Absent")
Set res = res.Resize(SD.Count, 1)
res.Value = Application.Transpose(SD.keys)
res.TextToColumns Destination:=res, DataType:=xlDelimited, Other:=True, OtherChar:="-"
End Sub
 
Upvote 0
On second thought, this way is probably more efficient.

VBA Code:
Sub UNQ2()
Application.ScreenUpdating = False
Dim ws1 As Worksheet: Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2")
Dim ws3 As Worksheet: Set ws3 = Sheets("Sheet3")
Dim r1 As Range: Set r1 = ws1.Range("A1:B" & ws1.Range("A" & Rows.Count).End(xlUp).Row)
Dim r2 As Range: Set r2 = ws2.Range("A2:B" & ws2.Range("A" & Rows.Count).End(xlUp).Row)

ws3.Range("A1").Resize(r1.Rows.Count, r1.Columns.Count).Value = r1.Value
ws3.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(r2.Rows.Count, r2.Columns.Count).Value = r2.Value
ws3.Range("A1").CurrentRegion.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Here's my attempt (similar to Irobbo314's first post though looking at his second I would probably use that):

Code:
Option Explicit
Sub Macro1()

    'https://www.mrexcel.com/board/threads/vba-unique-data-on-sheet3-from-data-on-sheet1-and-sheet2.1115898/
    'Adapted from here: https://stackoverflow.com/questions/40469932/how-do-i-get-all-the-different-unique-combinations-of-2-columns-using-vba-in-exc
   
    Dim lngMyRow As Long, lngLastRow As Long
    Dim varMySheet As Variant
    Dim ws As Worksheet
    Dim objDict As Object
   
    Application.ScreenUpdating = False

    Set objDict = CreateObject("Scripting.Dictionary")
   
    For Each varMySheet In Array("Sheet1", "Sheet2") 'Sheets to create unique list from
        Set ws = ThisWorkbook.Sheets(CStr(varMySheet))
        lngLastRow = ws.Range("A:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        For lngMyRow = 2 To lngLastRow
            objDict(ws.Cells(lngMyRow, "A").Value & "|" & ws.Cells(lngMyRow, "B").Value) = objDict(ws.Cells(lngMyRow, "A").Value & "|" & ws.Cells(lngMyRow, "B").Value)
        Next lngMyRow
    Next varMySheet

    With Sheets("Sheet3").Range("A2").Resize(objDict.Count) 'Output sheet and cell
        .Value = Application.Transpose(objDict.Keys)
        .TextToColumns Destination:=.Cells, DataType:=xlDelimited, Other:=True, OtherChar:="|"
    End With
   
    Set objDict = Nothing
   
    Application.ScreenUpdating = True

End Sub

Note there is no date 10/22/2018 in either Sheet1 or Sheet2 so no idea how it's in the final output (Sheet3) :confused:

I do have nine unique records though :)

Regards,

Robert
 
Upvote 0
I never think to loop through sheets like this. I like this a lot better than separately declaring all of those variables.

Thanks - I tend to forget about RemoveDuplicates :)
 
Upvote 0
Ahhhh yes!!! Thank you both!!! I appreciate all of your help. Trebor76 you were right about the 10/22/2018. This is what happens late at night LOL!
 
Upvote 0
I think I like this solution the best. If you use Power Query, you can add the tables from Sheet 1 and Sheet 2 as 'Connection Only'. Then under the 'Combine Group' on the 'Home' tab, select 'Append Queries'. Select both columns and 'Remove Duplicates'.

Anytime you add to one of the tables on Sheet1 or Sheet2, the results will reflect in the new table on Sheet3 without running code again.

Here's the M code.

Code:
let
    Source = Table.Combine({Table1, Table2}),
    Type = Table.TransformColumnTypes(Source,{{"Absence", type date}}),
    RemoveDuplicates = Table.Distinct(Type)
in
    RemoveDuplicates
 
Upvote 0
Irobbo314,

Yeah PowerQuery is no joke. Thank you so much for this solution. Works great!
 
Upvote 0

Forum statistics

Threads
1,213,567
Messages
6,114,342
Members
448,570
Latest member
rik81h

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top