Vlookup from multiple sheets without duplicates

[DataDad93]

I have three worksheets with financial reports from varying periods. Accounts (column B) are added and removed all the time meaning that rows do not perfectly match up. Account#123 may only be on sheet 2, while Account#456 may be on all 3 sheets. I need to compare account balance changes by period. I know I can get the period balance from the account# without issue with a simple VLOOKUP. I just need a way to search all 3 sheets and pull all account#s (column B) onto my report while making sure no accounts are skipped or duplicated throughout the report.

I hope I made this somewhat understandable,
Thanks!

 

[KHaag]

Hello DataDad93,
I would suggest using a Macro to add the list of Accounts to your report worksheet.
The following code should work:

Sub AddAccounts()
'
'
    Dim HeaderRow As Integer
    Dim DataStartRow As Integer
    Dim CopyFromCol As Integer
    Dim CopyToCol As Integer
    Dim LastRow As Integer
    Dim MySheet1 As String
    Dim MySheet2 As String
    Dim MySheet3 As String
    Dim MyReportSheet As String
'
'Define the Rows, Cols and Worksheet names for your file
'Be sure to include the Worksheet names in "'s
'
    HeaderRow = 6
    DataStartRow = HeaderRow + 1
    CopyFromCol = 2
    CopyToCol = 2
    MySheet1 = "2016 Time Log"
    MySheet2 = "2017 Time Log"
    MySheet3 = "2018 Time Log"
    MyReportSheet = "Test Sheet"
'
'The following code creates a temporary sheet on which to copy each list of Accounts,
'appending each list below the prior one. It then Sorts and does an Advanced Filter to hide
'all duplicate values, then copies the "shorened" list to where you want it.
'Once the copy is complete, it deletes the temporary sheet.
'
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "TempSheet"
    Sheets(MySheet1).Select
    Cells(HeaderRow, CopyFromCol).Select
    Range(ActiveCell, ActiveCell.End(xlDown)).Select
    Selection.Copy
    Sheets("TempSheet").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets(MySheet2).Select
    Cells(DataStartRow, CopyFromCol).Select
    Range(ActiveCell, ActiveCell.End(xlDown)).Select
    Selection.Copy
    Sheets("TempSheet").Select
    Range("A1").Select
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Cells(LastRow, 1).Offset(1, 0).Select
    ActiveSheet.Paste
    Sheets(MySheet3).Select
    Cells(DataStartRow, CopyFromCol).Select
    Range(ActiveCell, ActiveCell.End(xlDown)).Select
    Selection.Copy
    Sheets("TempSheet").Select
    Range("A1").Select
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Cells(LastRow, 1).Offset(1, 0).Select
    ActiveSheet.Paste
    Range("A1").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("TempSheet").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("TempSheet").AutoFilter.Sort.SortFields.Add Key:= _
        Range(ActiveCell, ActiveCell.End(xlDown)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("TempSheet").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range(ActiveCell, ActiveCell.End(xlDown)).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets(MyReportSheet).Select
    Cells(DataStartRow, CopyToCol).Select
    ActiveSheet.Paste
    Sheets("TempSheet").Select
    Application.CutCopyMode = False
    ActiveWindow.SelectedSheets.Delete
End Sub

 

[Fluff]

Hi & welcome to the board.
Another option

Sub CopyCompare()
   Dim Cl As Range
   Dim Ws As Worksheet

Application.ScreenUpdating = False
   With CreateObject("scripting.dictionary")
      For Each Ws In Worksheets
         If Ws.Name <> "[COLOR=#ff0000]Summary[/COLOR]" Then
            For Each Cl In Ws.Range("B2", Ws.Range("B" & Rows.Count).End(xlUp))
               If Not .exists(Cl.Value) Then .Add Cl.Value, Nothing
            Next Cl
         End If
      Next Ws
      Sheets("[COLOR=#ff0000]Summary[/COLOR]").Range("A2:A1048576").Clear
      Sheets("[COLOR=#ff0000]Summary[/COLOR]").Range("A2").Resize(.Count).Value = Application.Transpose(.keys)
   End With
End Sub

Change sheet name in red to suit

 

[KHaag]

Fluff,

Thank you so much for your response. I new there had to be a simpler way with that code, but hadn't worked that out yet.