Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Merging two simple worksheets based on header

Posted on 2013-01-14
3
Medium Priority
?
417 Views
Last Modified: 2013-02-07
hello,

I have a spreadsheet where I would like to merge the data from two worksheets onto another worksheet - an example file is attached ;)

Sheet1 - this is the worksheet I would like to be populated based upon information from sheet2 and sheet3.

I would like the code to run down the name column (column A) on sheet1 and look on sheet2 and sheet 3 for the same matching name which should also appear in Column A on each worksheet (sheet2 and 3). When it finds the same name on sheet2 or sheet3 I would like to copy the data over to Sheet1 and put it under the column where the header matches where it came from, for example the Age from Sheet2 would put the value under Age in sheet1.

I hope this makes sense, but please let me know if you have any questions, hopefully the attached spreadsheet will help.

Many thanks,

GISVPN
Example---Worksheet-Merge.xlsx
0
Comment
Question by:gisvpn
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
3 Comments
 
LVL 24

Expert Comment

by:Steve
ID: 38773967
Attached is the result using formula...

Would you like the dictionary object VBA method or will formula suffice?

Again this can depend upon volume of data.
Example---Worksheet-Merge.xlsx
0
 
LVL 24

Accepted Solution

by:
Steve earned 2000 total points
ID: 38773975
The code below will do the job in VBA too...

Private Function LastRow(TheWorksheet As Worksheet) As Long
If WorksheetFunction.CountA(TheWorksheet.Cells) > 0 Then
    LastRow = TheWorksheet.Cells.Find(What:="*", After:=TheWorksheet.Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End If
End Function
Sub Macro1()

Dim wsRows As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")

    ws.Range("B3").FormulaR1C1 = _
        "=IFERROR(INDEX(Sheet2!C[-1]:C[3],MATCH(Sheet1!RC[-1],Sheet2!C[-1],0),2),"""")"
    ws.Range("C3").FormulaR1C1 = _
        "=IFERROR(INDEX(Sheet3!C[-2]:C,MATCH(Sheet1!RC[-2],Sheet3!C[-2],0),2),"""")"
    ws.Range("D3").FormulaR1C1 = _
        "=IFERROR(INDEX(Sheet2!C[-3]:C[1],MATCH(Sheet1!RC[-3],Sheet2!C[-3],0),3),"""")"
    ws.Range("E3").FormulaR1C1 = _
        "=IFERROR(INDEX(Sheet3!C[-4]:C[-2],MATCH(Sheet1!RC[-4],Sheet3!C[-4],0),3),"""")"
    ws.Range("F3").FormulaR1C1 = _
        "=IFERROR(INDEX(Sheet2!C[-5]:C[-1],MATCH(Sheet1!RC[-5],Sheet2!C[-5],0),5),"""")"
    ws.Range("G3").FormulaR1C1 = _
        "=IFERROR(INDEX(Sheet2!C[-6]:C[-2],MATCH(Sheet1!RC[-6],Sheet2!C[-6],0),4),"""")"
    
    wsRows = LastRow(ws)
    
    ws.Range("B3:G3").AutoFill Destination:=ws.Range("B3:G" & wsRows)
    ws.Range("B3:G" & wsRows).Value = ws.Range("B3:G" & wsRows).Value
End Sub

Open in new window

Example---Worksheet-Merge--coded.xlsm
0
 
LVL 24

Assisted Solution

by:Steve
Steve earned 2000 total points
ID: 38774219
Below is code using two Dictionaries for the two tables...
This will be about the fastest possible solution...

Option Explicit
Private Function LastRow(TheWorksheet As Worksheet) As Long
If WorksheetFunction.CountA(TheWorksheet.Cells) > 0 Then
    LastRow = TheWorksheet.Cells.Find(What:="*", After:=TheWorksheet.Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End If
End Function
Sub Macro1()

'Create first Dictionary of sheet2
Dim MyDictionary As Scripting.Dictionary
Set MyDictionary = New Scripting.Dictionary
MyDictionary.CompareMode = vbBinaryCompare
Dim arr, x As Long
Dim ws As Worksheet
Set ws = Sheets("Sheet2")
arr = ws.Range("A1:E" & LastRow(ws)).Value
For x = 1 To UBound(arr, 1)
    If Not MyDictionary.Exists(arr(x, 1)) Then MyDictionary.Add arr(x, 1), Array(arr(x, 2), arr(x, 3), arr(x, 4), arr(x, 5))
Next

'Create second Dictionary of sheet3
Dim MyDictionary2 As Scripting.Dictionary
Set MyDictionary2 = New Scripting.Dictionary
MyDictionary2.CompareMode = vbBinaryCompare
Set ws = Sheets("Sheet3")

arr = ws.Range("A1:C" & LastRow(ws)).Value
For x = 1 To UBound(arr, 1)
    If Not MyDictionary2.Exists(arr(x, 1)) Then MyDictionary2.Add arr(x, 1), Array(arr(x, 2), arr(x, 3))
Next

'fill in array of missing data
Set ws = Sheets("Sheet1")
ws.Range("B3:G" & LastRow(ws)).Value = Empty
arr = ws.Range("A3:G" & LastRow(ws)).Value
For x = 1 To UBound(arr)
    If MyDictionary.Exists(arr(x, 1)) Then
        arr(x, 2) = MyDictionary.Item(arr(x, 1))(0)
        arr(x, 4) = MyDictionary.Item(arr(x, 1))(1)
        arr(x, 7) = MyDictionary.Item(arr(x, 1))(2)
        arr(x, 6) = MyDictionary.Item(arr(x, 1))(3)
    End If
    If MyDictionary2.Exists(arr(x, 1)) Then
        arr(x, 3) = MyDictionary2.Item(arr(x, 1))(0)
        arr(x, 5) = MyDictionary2.Item(arr(x, 1))(1)
    End If
Next x

ws.Range("A3:G" & LastRow(ws)).Value = arr

End Sub

Open in new window

0

Featured Post

Windows Server 2016: All you need to know

Learn about Hyper-V features that increase functionality and usability of Microsoft Windows Server 2016. Also, throughout this eBook, you’ll find some basic PowerShell examples that will help you leverage the scripts in your environments!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Outlook for dependable use in a very small business   This article is about using the Outlook application (part of Microsoft Office) in a very small business, or for homeowners where dependability and reliability are critical requirements. This …
Microsoft has changed the look and feel of Azure AD and Microsoft account sign-in pages so that you will have a more unified look and feel when moving between the two interfaces.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

722 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question