Sub Button1_Click()
Consolidate3
End Sub
Sub Consolidate3(): Dim S, W, ws As Worksheet, wc As Worksheet, i As Long, j As Long, q As Long
Dim FirstSheet As Boolean: FirstSheet = True
Dim k As Integer, r As Long, er As Long, c As Long, ec As Long, p As Long
Set wc = Sheets("Combined"): c = wc.Columns.Find("*", , , , xlByColumns, xlPrevious).Column
GetResponseIDs:
For k = 1 To Worksheets.Count
If Included(Worksheets(k).Name) Then
Set ws = Worksheets(k)
er = ws.Rows.Find("*", , , , xlByRows, xlPrevious).Row
ec = ws.Columns.Find("*", , , , xlByColumns, xlPrevious).Column
If FirstSheet Then
For i = 2 To er:
wc.Range("B" & i) = ws.Range("A" & i): wc.Range("C" & i) = ws.Range("B" & i)
Next i
FirstSheet = False: GoTo GetNext: End If
For i = 2 To er
If wc.Range("B" & j) <= ws.Range("A" & i) Then
j = j + 1
ElseIf wc.Range("B" & j) > ws.Range("A" & i) Then
wc.Range("B" & j).EntireRow.Insert Shift:=xlDown
wc.Range("B" & j) = ws.Range("A" & i): wc.Range("C" & j) = ws.Range("B" & i)
j = j + 1
End If
Next i
If ws.Range("A" & er) > wc.Range("B" & j) And _
ws.Range("A" & er) > wc.Range("B" & j - 1) Then
wc.Range("B" & j) = ws.Range("A" & er): wc.Range("C" & j) = ws.Range("B" & er)
End If
End If
GetNext: j = 2
Next k: r = wc.Rows.Find("*", , , , xlByRows, xlPrevious).Row
S = wc.Range(wc.Cells(1, 1), wc.Cells(r, c))
For k = 1 To Worksheets.Count
If Included(Worksheets(k).Name) Then
Set ws = Worksheets(k)
er = ws.Rows.Find("*", , , , xlByRows, xlPrevious).Row
ec = ws.Columns.Find("*", , , , xlByColumns, xlPrevious).Column
W = ws.Range(ws.Cells(1, 1), ws.Cells(er, ec))
For q = 3 To ec
p = 4: Do Until S(1, p) = W(1, q): p = p + 1
If p > c Then GoTo GetAnother
Loop
For i = 2 To er
j = 2: Do Until S(j, 2) = W(i, 1): j = j + 1
If j > r Then GoTo GetAnother
Loop
S(j, p) = W(i, q)
Next i
GetAnother: Next q
End If: Next k
wc.Range(wc.Cells(1, 1), wc.Cells(r, c)) = S
End Sub
Function Included(N As String) As Boolean
Dim WSheets, i As Integer: Included = True
WSheets = Array(" ", "AddHeader", "CodeList", "AddColumns", _
"Summary", "Reports", "CAPI", "Combined")
For i = 1 To UBound(WSheets)
If N = WSheets(i) Then
Included = False: Exit Function
End If: Next
End Function
Bookmarks