Sub Section1()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim LastRow1 As Long
Dim iCol As Long
Dim ws As Worksheet
For Each ws In Worksheets(Array("EL Listing", "PL Listing", "Med Mal Listing", "PDBI Listing", "Legal Expense Listing"))
ws.UsedRange.RemoveSubtotal
Next ws
Set ws = Nothing
Sheets("Data").Activate
iCol = 1
[A1].CurrentRegion.AutoFilter iCol, "PL"
Dim SearchCols(14) As String
SearchCols(0) = "Claim Reference"
SearchCols(1) = "Policy Year"
SearchCols(2) = "INC.DTE"
SearchCols(3) = "INSURER REF"
SearchCols(4) = "CLIENT"
SearchCols(5) = "CLAIMANT"
SearchCols(6) = "Cause"
SearchCols(7) = "TYPE/CIRCUMSTANCES"
SearchCols(8) = "NATURE OF INJURY"
SearchCols(9) = "Outstanding"
SearchCols(10) = "PAID"
SearchCols(11) = "TOTAL"
SearchCols(12) = "Status"
SearchCols(13) = "CLAIM / INCIDENT"
SearchCols(14) = "COMMENTARY"
'continue with all the column names
Dim i As Integer
'Find "Entity" in Row 1
Sheets("PL Listing").Activate
Rows("5:" & Rows.Count).ClearContents
With Sheets("Data").Rows(1)
For i = LBound(SearchCols) To UBound(SearchCols)
Set t = .Find(SearchCols(i), LookAt:=xlPart)
'If found, copy the column to Sheet 2, Column A
'If not found, present a message
If Not t Is Nothing Then
If Sheets("PL Listing").Range("B5").Value = "" Then
pasteCol = 2
Else
pasteCol = Sheets("PL Listing").Cells(5, .Columns.Count).End(xlToLeft).Offset(0, 1).Column
End If
.Columns(t.Column).EntireColumn.Copy _
Destination:=Sheets("PL Listing").Cells(5, pasteCol)
Else
MsgBox SearchCols(i) & " Not Found"
End If
Next
End With
Sheets("PL Listing").Activate
'Sheets("PL Listing").AutoFilterMode = False
Rows("5").EntireRow.Delete
LastRow1 = Range("B" & Rows.Count).End(xlUp).Row
Range("$B$5:$P$" & LastRow1).Select
Selection.Borders(xlEdgeTop).LineStyle = xlDot
Selection.Borders(xlEdgeBottom).LineStyle = xlDot
Selection.Borders(xlInsideHorizontal).LineStyle = xlDot
LastRow1 = Empty
i = Empty
t = Empty
Erase SearchCols
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub Section2()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim LastRow1 As Long
Dim iCol As Long
Sheets("Data").Activate
iCol = 1
[A1].CurrentRegion.AutoFilter iCol, "EL"
Dim SearchCols(13) As String
SearchCols(0) = "Claim Reference"
SearchCols(1) = "Policy Year"
SearchCols(2) = "INC.DTE"
SearchCols(3) = "INSURER REF"
SearchCols(4) = "CLIENT"
SearchCols(5) = "CLAIMANT"
SearchCols(6) = "Cause"
SearchCols(7) = "TYPE/CIRCUMSTANCES"
SearchCols(8) = "NATURE OF INJURY"
SearchCols(9) = "Outstanding"
SearchCols(10) = "PAID"
SearchCols(11) = "TOTAL"
SearchCols(12) = "Status"
SearchCols(13) = "CLAIM / INCIDENT"
'continue with all the column names
Dim i As Integer
'Find "Entity" in Row 1
Sheets("EL Listing").Activate
Rows("5:" & Rows.Count).ClearContents
With Sheets("Data").Rows(1)
For i = LBound(SearchCols) To UBound(SearchCols)
Set t = .Find(SearchCols(i), LookAt:=xlPart)
'If found, copy the column to Sheet 2, Column A
'If not found, present a message
If Not t Is Nothing Then
If Sheets("EL Listing").Range("B5").Value = "" Then
pasteCol = 2
Else
pasteCol = Sheets("EL Listing").Cells(5, .Columns.Count).End(xlToLeft).Offset(0, 1).Column
End If
.Columns(t.Column).EntireColumn.Copy _
Destination:=Sheets("EL Listing").Cells(5, pasteCol)
Else
MsgBox SearchCols(i) & " Not Found"
End If
Next
End With
Sheets("EL Listing").Activate
Rows("5").EntireRow.Delete
LastRow1 = Range("B" & Rows.Count).End(xlUp).Row
Range("$B$5:$P$" & LastRow1).Select
Selection.Borders(xlEdgeTop).LineStyle = xlDot
Selection.Borders(xlEdgeBottom).LineStyle = xlDot
Selection.Borders(xlInsideHorizontal).LineStyle = xlDot
LastRow1 = Empty
Erase SearchCols
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub Section3()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim LastRow1 As Long
Dim iCol As Long
Sheets("Data").Activate
iCol = 1
[A1].CurrentRegion.AutoFilter iCol, "PDBI"
Dim SearchCols(10) As String
SearchCols(0) = "Claim Reference"
SearchCols(1) = "Policy Year"
SearchCols(2) = "INC.DTE"
SearchCols(3) = "CLIENT"
SearchCols(4) = "Cause"
SearchCols(5) = "TYPE/CIRCUMSTANCES"
SearchCols(6) = "Outstanding"
SearchCols(7) = "PAID"
SearchCols(8) = "TOTAL"
SearchCols(9) = "Status"
SearchCols(10) = "COMMENTARY"
'continue with all the column names
Dim i As Integer
'Find "Entity" in Row 1
Sheets("PDBI Listing").Activate
Rows("5:" & Rows.Count).ClearContents
With Sheets("Data").Rows(1)
For i = LBound(SearchCols) To UBound(SearchCols)
Set t = .Find(SearchCols(i), LookAt:=xlPart)
'If found, copy the column to Sheet 2, Column A
'If not found, present a message
If Not t Is Nothing Then
If Sheets("PDBI Listing").Range("B5").Value = "" Then
pasteCol = 2
Else
pasteCol = Sheets("PDBI Listing").Cells(5, .Columns.Count).End(xlToLeft).Offset(0, 1).Column
End If
.Columns(t.Column).EntireColumn.Copy _
Destination:=Sheets("PDBI Listing").Cells(5, pasteCol)
Else
MsgBox SearchCols(i) & " Not Found"
End If
Next
End With
Sheets("PDBI Listing").Activate
Rows("5").EntireRow.Delete
LastRow1 = Range("B" & Rows.Count).End(xlUp).Row
Range("$B$5:$P$" & LastRow1).Select
Selection.Borders(xlEdgeTop).LineStyle = xlDot
Selection.Borders(xlEdgeBottom).LineStyle = xlDot
Selection.Borders(xlInsideHorizontal).LineStyle = xlDot
LastRow1 = Empty
Erase SearchCols
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub Section4()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim LastRow1 As Long
Dim iCol As Long
Sheets("Data").Activate
iCol = 1
[A1].CurrentRegion.AutoFilter iCol, "Med Mal"
Dim SearchCols(14) As String
SearchCols(0) = "Claim Reference"
SearchCols(1) = "Policy Year"
SearchCols(2) = "INC.DTE"
SearchCols(3) = "INSURER REF"
SearchCols(4) = "CLIENT"
SearchCols(5) = "CLAIMANT"
SearchCols(6) = "Cause"
SearchCols(7) = "TYPE/CIRCUMSTANCES"
SearchCols(8) = "NATURE OF INJURY"
SearchCols(9) = "Outstanding"
SearchCols(10) = "PAID"
SearchCols(11) = "TOTAL"
SearchCols(12) = "Status"
SearchCols(13) = "CLAIM / INCIDENT"
SearchCols(14) = "COMMENTARY"
'continue with all the column names
Dim i As Integer
'Find "Entity" in Row 1
Sheets("Med Mal Listing").Activate
Rows("5:" & Rows.Count).ClearContents
With Sheets("Data").Rows(1)
For i = LBound(SearchCols) To UBound(SearchCols)
Set t = .Find(SearchCols(i), LookAt:=xlPart)
'If found, copy the column to Sheet 2, Column A
'If not found, present a message
If Not t Is Nothing Then
If Sheets("Med Mal Listing").Range("B5").Value = "" Then
pasteCol = 2
Else
pasteCol = Sheets("Med Mal Listing").Cells(5, .Columns.Count).End(xlToLeft).Offset(0, 1).Column
End If
.Columns(t.Column).EntireColumn.Copy _
Destination:=Sheets("Med Mal Listing").Cells(5, pasteCol)
Else
MsgBox SearchCols(i) & " Not Found"
End If
Next
End With
Sheets("Med Mal Listing").Activate
Rows("5").EntireRow.Delete
LastRow1 = Range("B" & Rows.Count).End(xlUp).Row
Range("$B$5:$P$" & LastRow1).Select
Selection.Borders(xlEdgeTop).LineStyle = xlDot
Selection.Borders(xlEdgeBottom).LineStyle = xlDot
Selection.Borders(xlInsideHorizontal).LineStyle = xlDot
LastRow1 = Empty
Erase SearchCols
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub Formating()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ActiveWorkbook.RefreshAll
Dim ws As Worksheet
For Each ws In Worksheets(Array("EL Listing", "PL Listing", "Med Mal Listing", "Legal Expense Listing"))
With ws.Range("B5")
.RemoveSubtotal
.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(10, 11, 12), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End With
Next ws
Set ws = Nothing
Sheets("PDBI Listing").Range("B5").Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(7, 8, 9), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub