I have a workbook with over 90 sheets. Each sheet contains data for respective request Number (customer). Each sheet contains a row 1= key (Profile Section &"_"& Header), row 2= Profile section, Row 3= Header within each section, and then data rows for request number (1 or more rows). We need to compile the data for specified headers from all the tabs and compile together in a dataset.
I have a list of headers in the dashboard sheet (Table name "Parameters"). This is copied to as column headers for tab "Customer Dataset".
Currently, i have written the code for deleting the old sheet "Customer Dataset" and creating new sheet, with updated list of required headers (flexibility of updating headers) .
Look for the header key in row 3 of "Customer Dataset" and match it with row 1 of first customer sheet, and pull the column values in tab "Customer dataset". Look for other header and repeat the same. So we will have customer data rows for the 1 customer for all specified headers.
Now, this exercise needs to be repeated across all other customer tabs and the data needs to be appended in the sheet "Customer Dataset"
Any other suggested approach is also highly appreciated. For testing purpose I am currently running the code only across 3 sheets.
Pulling selected parameters data in one worksheet
Sub PullData()
Dim wbcompile As Workbook
Dim wssrc, wsdest As Worksheet
Dim ws_Count As Integer
Dim Par_Count As Integer
Dim Par As ListObject
Application.DisplayAlerts = False
Set wbcompile = ActiveWorkbook
wbcompile.Worksheets("Customer Dataset").Delete
Application.DisplayAlerts = False
Sheets.Add After:=wbcompile.Worksheets("Dashboard")
ActiveSheet.Name = "Customer Dataset"
Set wsdest = ActiveWorkbook.Sheets("Customer Dataset")
Sheets("Dashboard").Select
Set Par = Worksheets("Dashboard").ListObjects("Parameters")
Par_Count = Par.ListColumns(2).Range.Count
Application.Goto Reference:="Parameters"
Selection.Copy
Sheets("Customer Dataset").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Debug.Print Par_Count
ws_Count = ActiveWorkbook.Worksheets.Count - 2
Debug.Print ws_Count
End Sub
Something like this (compiled but not tested):
Sub PullData()
Dim wbcompile As Workbook
Dim wsSrc As Worksheet, wsDest As Worksheet, wsPar As Worksheet '<< every variable needs a type
Dim loPar As ListObject, arr
Set wbcompile = ActiveWorkbook
Set wsPar = wbcompile.Worksheets("Dashboard")
Set loPar = wsPar.ListObjects("Parameters")
arr = loPar.DataBodyRange.Value 'get parameters as array
Set wsDest = wbcompile.Worksheets("Customer Dataset")
wsDest.Cells.Clear
'flip the array and place on summary sheet
wsDest.Range("A1").Resize(UBound(arr, 2), UBound(arr, 1)).Value = Application.Transpose(arr)
For Each wsSrc In wbcompile.Worksheets
'extract from this sheet?
If wsSrc.Name <> wsDest.Name And wsSrc.Name <> wsPar.Name Then
ExtractData wsSrc, wsDest
End If
Next wsSrc
End Sub
Sub ExtractData(wsSrc As Worksheet, wsDest As Worksheet)
Dim lrSrc As Long, nextRowDest As Long, c As Range, m
lrSrc = LastOccupiedRow(wsSrc) 'last row of data on source sheet
If lrSrc = 3 Then Exit Sub 'no data
nextRowDest = LastOccupiedRow(wsDest) + 1 'next row to paste to on summary sheet
'loop over headers in row1 of source sheet
For Each c In wsSrc.Range("A1", wsSrc.Cells(1, Columns.Count).End(xlToLeft)).Cells
m = Application.Match(c.Value, wsDest.Rows(3), 0) 'match on summary sheet row 3?
If Not IsError(m) Then 'got a match?
'copy row 4 to last row to the summary sheet
wsSrc.Range(wsSrc.Cells(4, c.Column), wsSrc.Cells(lrSrc, c.Column)).Copy _
wsDest.Cells(nextRowDest, m)
End If
Next c
End Sub
Function LastOccupiedRow(ws As Worksheet) As Long
Dim f As Range
Set f = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not f Is Nothing Then LastOccupiedRow = f.Row
End Function