Solved

Merging two simple worksheets based on header

Posted on 2013-01-14
3
366 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
  • 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 500 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 500 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

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

757 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

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now