You can't, but see here: Attachments
Are they all in the same workbook? If so, what are their names? If not, how do we locate & identify the relevant sheets?
Does the destination sheet already exist? If so, what is its name and does it already contain data that must be retained?
Sub Combine_And_Align()
Dim d As Object
Dim ws As Worksheet
Dim a As Variant, b As Variant
Dim i As Long, k As Long, rw As Long
Dim SDT As String
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = 1
ReDim b(1 To Rows.Count, 1 To 9)
For Each ws In Sheets(Array("Data1", "Data2", "Data3")) '<- Data sheet names here
a = ws.Range("A1").CurrentRegion.Value
For i = 2 To UBound(a)
SDT = a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3)
If Not d.exists(SDT) Then
rw = rw + 1
d(SDT) = rw
b(rw, 1) = a(i, 1): b(rw, 2) = a(i, 2): b(rw, 3) = a(i, 3)
End If
b(d(SDT), 4 + k) = a(i, 4)
b(d(SDT), 5 + k) = a(i, 5)
Next i
k = k + 2
Next ws
With Sheets("Summary") '<- Summary sheet name here
.UsedRange.ClearContents
With .Range("A2").Resize(rw, UBound(b, 2))
.Value = b
.Cells(0, 1).Resize(, 9).Value = Array("State", "DOC", "Type", "Begin 1", "End 1", "Begin 2", "End 2", "Begin 3", "End 3")
.CurrentRegion.EntireColumn.AutoFit
End With
End With
End Sub| Excel 2016 (Windows) 32 bit | |||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|
| A | B | C | D | E | F | G | H | I | |||
| 1 | State | DOC | Type | Begin 1 | End 1 | Begin 2 | End 2 | Begin 3 | End 3 | ||
| 2 | Chicago | PA | 1 | 7 | 7 | 6 | 6 | 5 | 4 | ||
| 3 | Chicago | PA | 2 | 1 | 0 | 1 | 0 | ||||
| 4 | Chicago | PA | 3 | 12 | 12 | 20 | 16 | 3 | 2 | ||
| 5 | Chicago | PB | 3 | 5 | 5 | 9 | 9 | 5 | 5 | ||
| 6 | Chicago | PC | 1 | ||||||||
| 7 | Chicago | PC | 3 | 1 | 1 | 2 | 2 | ||||
| 8 | Chicago | PD | 4 | ||||||||
| 9 | Chicago | PD | 1 | 158 | 154 | 166 | 158 | 210 | 204 | ||
| 10 | Chicago | PD | 2 | 91 | 85 | 107 | 101 | ||||
| 11 | Chicago | PD | 3 | 613 | 611 | 658 | 657 | ||||
| 12 | Chicago | PE | 3 | 4 | 4 | ||||||
Summary | |||||||||||
Sub aTest()
Dim dic As Object, sh As Variant, strKey As String
Dim vData As Variant, i As Long, lCounter As Long, vAux As Variant
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
lCounter = 0
For Each sh In Array("Sheet1", "Sheet2", "Sheet3") '<--Adjust sheet names
With Sheets(sh)
vData = .Range("A2:E" & .Cells(.Rows.Count, "A").End(xlUp).Row)
For i = LBound(vData, 1) To UBound(vData, 1)
strKey = vData(i, 1) & "|" & vData(i, 2) & "|" & vData(i, 3)
If dic.exists(strKey) Then
vAux = dic(strKey)
vAux(lCounter) = vData(i, 4)
vAux(lCounter + 1) = vData(i, 5)
dic(strKey) = vAux
Else
Select Case lCounter
Case 0
dic(strKey) = Array(vData(i, 4), vData(i, 5), "", "", "", "")
Case 2
dic(strKey) = Array("", "", vData(i, 4), vData(i, 5), "", "")
Case 4
dic(strKey) = Array("", "", "", "", vData(i, 4), vData(i, 5))
End Select
End If
Next i
End With
lCounter = lCounter + 2
Next sh
With Sheets("Master") '<--adjust sheet name
.Columns("A:I").ClearContents
.Range("A1:I1").Value = Array("State", "DOC", "Type", "Begin 1", "End 1", "Begin 2", "End 2", "Begin 3", "End 3")
.Range("A2").Resize(dic.Count).Value = Application.Transpose(dic.keys)
For i = 2 To dic.Count + 1
.Range("D" & i).Resize(, 6) = dic(.Range("A" & i).Value)
Next i
.Range("A2").Resize(dic.Count).TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
OtherChar:="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1))
End With
End Sub1. With your workbook active press Alt+F11 to bring up the vba window.
