Maybe...
'Lines added in four places marked with '<<<<
'--
Sub CombineTs()
Dim rr As Integer 'row count of Summary
Dim n As Integer 'sheet count
Dim m As Integer 'column count Summary
Dim t As Integer
Dim s() As Variant 'row count others
Dim u As Integer 'cumulative row count
Dim ss As String 'name of Summary
Dim sc() As Variant 'column names in Summary
Dim ssc() As Variant 'column count others
Dim i As Integer
Dim j As Integer
ss = "Summary"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
n = ActiveWorkbook.Worksheets.Count
ReDim s(n + 1)
ReDim ssc(n + 1)
u = 1
For t = 1 To n
If Not ss = Worksheets(t).Name And Worksheets(t).ListObjects.Count = 1 Then
s(t) = Worksheets(t).ListObjects(1).ListRows.Count
ssc(t) = Worksheets(t).ListObjects(1).ListColumns.Count
End If
Application.StatusBar = "Part One of Four " & Format$(t / n, "#00%") '<<<<
Next t
With Sheets("Summary").ListObjects(1) 'Delete old data
.AutoFilter.ShowAllData
m = .ListColumns.Count
ReDim sc(m + 1)
For i = 1 To m
sc(i) = .ListColumns(i).Name
Application.StatusBar = "Part Two " & Format$(i / m, "#00%") '<<<<
Next i
rr = .ListRows.Count
For t = 1 To rr - 1 'Delete all but one row
.ListRows(1).Delete
Application.StatusBar = "Part Three " & Format$(t / rr, "#00%") '<<<<
Next t
End With
For t = 1 To n
With Sheets(t)
If Not ss = .Name And .ListObjects.Count = 1 Then
For i = 1 To m
For j = 1 To ssc(t)
If sc(i) = .ListObjects(1).ListColumns(j).Name Then
.ListObjects(1).ListColumns(j).DataBodyRange.Copy _
Sheets("Summary").ListObjects(1).ListColumns(i).DataBodyRange.Cells(u)
End If
Next j
Next i
u = u + s(t)
End If
End With
Application.StatusBar = "Last Part " & Format$(t / n, "#00%") '<<<<
Next t
With Sheets("Summary").ListObjects(1)
.Range.AutoFilter Field:=3, Criteria1:=">0"
End With
End Sub
--
Jim Cone
Portland, Oregon USA
"Telecorder"
<
[email protected]>
wrote in message
Apologies - but ...I'm lost...
The following is the module code that I'm using upon Form Button Click to
generate the consolidated data to populate my Summary page (Users enter
quantities on 13 worksheets for various items and code brings over only those
rows with entered quantities.
Is there a way to generate a Progress Indicator Status tied to the ws search
of data field's? ie - How do I code the following to include Jim's Status Bar
progress approach, at the least, or how would I tie a separate UserForm bar
indicator approach activation to the Form Button click that activates the
following (and have it calculate completion %...)?
Many Thanks in advance...
-snip-