```
Private Sub CommandButton1_Click()
Dim wb1 As Workbook
Dim ws As Worksheet, ws1 As Worksheet
Dim LastRowWs As Long, c1 As Long, i As Long, LstRw As Long
Dim Rng1 As Range, Rng2 As Range
Dim Head1a As Boolean, Head1b As Boolean, Head1c As Boolean
Dim Head2a As Boolean, Head2b As Boolean
Set wb1 = Workbooks.Open(FilePath)
Set ws1 = wb1.Sheets.Add(after:=wb1.Sheets(Sheets.Count))
ws1.Name = "Summary"
ws1.Range("A1:D1") = Array("SHEETNAME", "MEDIAN", "MODE", "TOTAL JOB:")
LstRw = 2
For Each ws In wb1.Worksheets
If ws.Name <> "Summary" Then
With ws
Head1a = False: Head1b = False: Head1c = False
Head2a = False: Head2b = False
LastRowWs = .Range("A" & .Rows.Count).End(xlUp).Row
c1 = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
.Cells(1, c1) = headerText
'~~> Check for HeaderText1a
For i = 1 To c1 - 1
If InStr(1, .Cells(1, i).Value, HeaderText1a, vbTextCompare) Then
Head1a = True
Set Rng1 = .Cells(1, i)
Exit For
End If
Next i
'~~> Check for HeaderText1b
For i = 1 To c1 - 1
If InStr(1, .Cells(1, i).Value, HeaderText1b, vbTextCompare) Then
Head1b = True
Set Rng1 = .Cells(1, i)
Exit For
End If
Next i
'~~> Check for HeaderText1c
If Head1a = True Or Head1b = True Then
For i = 1 To c1 - 1
If InStr(1, .Cells(1, i).Value, HeaderText1c, vbTextCompare) Then
Head1c = True
Set Rng2 = .Cells(1, i)
Exit For
End If
Next i
End If
'~~> Check for HeaderText2a if the above is not found
If Head1c = False Then
For i = 1 To c1 - 1
If InStr(1, .Cells(1, i).Value, HeaderText2a, vbTextCompare) Then
Head2a = True
Set Rng1 = .Cells(1, i)
Exit For
End If
Next i
End If
'~~> Check for HeaderText2b
If Head2a = True Then
For i = 1 To c1 - 1
If InStr(1, .Cells(1, i).Value, HeaderText2b, vbTextCompare) Then
Head2a = True
Set Rng2 = .Cells(1, i)
Exit For
End If
Next i
End If
.Cells(2, c1).Formula = "=ABS(NETWORKDAYS(" & Replace(Rng1.Offset(1).Address, "$", "") & _
"," & _
Replace(Rng2.Offset(1).Address, "$", "") & _
"))"
On Error Resume Next
.Cells(2, c1).AutoFill Destination:=.Range(.Cells(2, c1).Address & ":" & .Cells(LastRowWs, c1).Address), Type:=xlFillDefault
On Error GoTo 0
.Cells(LastRowWs + 1, c1 - 1) = "MEDIAN"
.Cells(LastRowWs + 1, c1).Formula = "=MEDIAN(" & .Cells(2, c1).Address & ":" & .Cells(LastRowWs, c1).Address & ")"
.Cells(LastRowWs + 2, c1 - 1) = "MODE"
.Cells(LastRowWs + 2, c1).Formula = "=MODE(" & .Cells(2, c1).Address & ":" & .Cells(LastRowWs, c1).Address & ")"
.Cells(LastRowWs + 3, c1 - 1) = "TOTAL JOB:"
.Cells(LastRowWs + 3, c1).Formula = "=COUNT(" & .Cells(2, c1).Address & ":" & .Cells(LastRowWs, c1).Address & ")"
.Cells.EntireColumn.AutoFit
ws1.Cells(LstRw, 1) = .Name
ws1.Cells(LstRw, 2).Resize(1, 3) = Application.Transpose(.Cells(LastRowWs + 1, c1).Resize(3, 1).Value)
LstRw = LstRw + 1
End With
End If
Next
ws1.Cells.EntireColumn.AutoFit
' wb1.Close savechanges = True
' Set ws = Nothing
' Set ws1 = Nothing
' Set wb1 = Nothing
MsgBox "Done"
End Sub
```