Galapagos15
Board Regular
- Joined
- Sep 16, 2015
- Messages
- 100
The coding below is for a broker statement that was imported from a PDF into one excel tab. Basically it is "Finding" key words and then cutting and pasting that section of data to other tabs and reformatting each tab. If one of the "Find" key words is missing how do I tell it to continue onto the next "Find" key word so the coding will continue to run it's course? The "Find" key words are Individual Accounts, 1-50 Group Commissions, 51+ Group Commission, Exchange Individual Accounts, Exchange 1-50 Group Commissions, Individual New Sales Bonus, IMD Voluntary Dental Override, Off Exchange Commission Withheld, On Exchange Commission Withheld, Off Exchange Bonus Withheld, Cancelled Groups/Accounts. Thanks in advance!
Sub BrokerAcct()
'
' Excel Macro
' Reformat Statements
'
'
Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C1").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H1").Select
Selection.Cut
Range("C1").Select
ActiveSheet.Paste
Range("D1").Select
Selection.Cut
Range("A2").Select
ActiveSheet.Paste
Range("E1").Select
Selection.Cut
Range("B2").Select
ActiveSheet.Paste
Range("J1").Select
Selection.Cut
Range("C2").Select
ActiveSheet.Paste
Range("G1").Select
Selection.Cut
Range("A3").Select
ActiveSheet.Paste
Range("F1").Select
Selection.Cut
Range("B3").Select
ActiveSheet.Paste
Range("L1").Select
Selection.Cut
Range("C3").Select
ActiveSheet.Paste
Range("I1").Select
Selection.Cut
Range("A4").Select
ActiveSheet.Paste
Range("N1").Select
Selection.Cut
Range("C4").Select
ActiveSheet.Paste
Range("K1").Select
Selection.Cut
Range("A5").Select
ActiveSheet.Paste
Range("O1").Select
Selection.Cut
Range("C5").Select
ActiveSheet.Paste
Range("M1").Select
Selection.Cut
Range("A6").Select
ActiveSheet.Paste
Range("P1").Select
Selection.Cut
Range("C6").Select
ActiveSheet.Paste
ActiveSheet.Name = "Summary"
Range("A1:C6").Select
Selection.Font.Bold = True
ActiveWindow.SmallScroll Down:=21
Rows("41:41").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("43:43").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C42:D42").Select
Selection.Cut
Range("A43").Select
ActiveSheet.Paste
Range("E42:F42").Select
Selection.Cut
Range("A44").Select
ActiveSheet.Paste
Range("G42:H42").Select
Selection.Cut
Range("A45").Select
ActiveSheet.Paste
Range("I42:J42").Select
Selection.Cut
Range("A46").Select
ActiveSheet.Paste
Range("K42:L42").Select
Selection.Cut
Range("A47").Select
ActiveSheet.Paste
Range("M42:N42").Select
Selection.Cut
Range("A48").Select
ActiveSheet.Paste
Range("O42:P42").Select
Selection.Cut
Range("A49").Select
ActiveSheet.Paste
Rows("51:55").Select
Selection.Delete Shift:=xlUp
Rows("51:51").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Sheets.Add After:=Sheets(Sheets.Count)
Range("A1").Select
ActiveSheet.Paste
Rows("1:1").Select
Selection.Font.Bold = True
Columns("A:M").Select
Selection.ColumnWidth = 30
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 2
ActiveSheet.Name = "Individual Accts"
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells.Select
With Selection.Font
.Name = "ARIAL"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection.Font
.Color = -4165632
.TintAndShade = 0
End With
Set sh = ActiveSheet
On Error Resume Next
Set fn = sh.Range("A:A").Find(What:="1-50 Group Commissions", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
Sheets.Add After:=Sheets(Sheets.Count)
sh.Range(fn, sh.Cells(Rows.Count, 1).End(xlUp)).EntireRow.Cut ActiveSheet.Range("A1")
Columns("A:Z").Select
Selection.ColumnWidth = 30
Rows("1:1").Select
Selection.Font.Bold = True
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = "1-50 Group Commissions"
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection.Font
.Name = "ARIAL"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection.Font
.Color = -4165632
.TintAndShade = 0
End With
Range("A1:B1").Select
Selection.Cut
Range("H1").Select
Selection.Insert Shift:=xlToRight
On Error Resume Next
Set fn = ActiveSheet.Range("A:A").Find(What:="51+ Group Commission", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
Set sh = ActiveSheet
Sheets.Add After:=Sheets(Sheets.Count)
With sh
.Range(fn, .Cells(Rows.Count, 1).End(xlUp)).EntireRow.Cut ActiveSheet.Range("A1")
End With
Columns("A:Z").Select
Selection.ColumnWidth = 30
Rows("1:1").Select
Selection.Font.Bold = True
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = "51+ Group Commissions"
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection.Font
.Name = "ARIAL"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection.Font
.Color = -4165632
.TintAndShade = 0
End With
Range("A1").Select
Selection.Delete Shift:=xlToLeft
On Error Resume Next
Set fn = ActiveSheet.Range("A:A").Find(What:="Exchange Individual Accounts", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
Set sh = ActiveSheet
Sheets.Add After:=Sheets(Sheets.Count)
With sh
.Range(fn, .Cells(Rows.Count, 1).End(xlUp)).EntireRow.Cut ActiveSheet.Range("A1")
End With
Columns("A:Z").Select
Selection.ColumnWidth = 30
Rows("1:1").Select
Selection.Font.Bold = True
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = "Exchange Ind Accounts"
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection.Font
.Name = "ARIAL"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection.Font
.Color = -4165632
.TintAndShade = 0
End With
On Error Resume Next
Set fn = ActiveSheet.Range("A:A").Find(What:="Exchange 1-50 Group Commissions", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
Set sh = ActiveSheet
Sheets.Add After:=Sheets(Sheets.Count)
With sh
.Range(fn, .Cells(Rows.Count, 1).End(xlUp)).EntireRow.Cut ActiveSheet.Range("A1")
End With
Columns("A:Z").Select
Selection.ColumnWidth = 30
Rows("1:1").Select
Selection.Font.Bold = True
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = "Exchange 1-50 Group Comm"
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection.Font
.Name = "ARIAL"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection.Font
.Color = -4165632
.TintAndShade = 0
End With
Range("I1:J1").Select
Selection.Cut
Range("A1").Select
Selection.Insert Shift:=xlToRight
On Error Resume Next
Set fn = ActiveSheet.Range("A:A").Find(What:="Individual New Sales Bonus", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
Set sh = ActiveSheet
Sheets.Add After:=Sheets(Sheets.Count)
With sh
.Range(fn, .Cells(Rows.Count, 1).End(xlUp)).EntireRow.Cut ActiveSheet.Range("A1")
End With
Columns("A:Z").Select
Selection.ColumnWidth = 30
Rows("1:1").Select
Selection.Font.Bold = True
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = "Indiv New Sales Bonus"
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection.Font
.Name = "ARIAL"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection.Font
.Color = -4165632
.TintAndShade = 0
End With
On Error Resume Next
Set fn = ActiveSheet.Range("A:A").Find(What:="IMD Voluntary Dental Override", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
Set sh = ActiveSheet
Sheets.Add After:=Sheets(Sheets.Count)
With sh
.Range(fn, .Cells(Rows.Count, 1).End(xlUp)).EntireRow.Cut ActiveSheet.Range("A1")
End With
Columns("A:Z").Select
Selection.ColumnWidth = 30
Rows("1:1").Select
Selection.Font.Bold = True
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = "IMD Dental Override"
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection.Font
.Name = "ARIAL"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection.Font
.Color = -4165632
.TintAndShade = 0
End With
On Error Resume Next
Set fn = ActiveSheet.Range("A:A").Find(What:="Off Exchange Commission Withheld", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
Set sh = ActiveSheet
Sheets.Add After:=Sheets(Sheets.Count)
With sh
.Range(fn, .Cells(Rows.Count, 1).End(xlUp)).EntireRow.Cut ActiveSheet.Range("A1")
End With
Columns("A:Z").Select
Selection.ColumnWidth = 30
Rows("1:1").Select
Selection.Font.Bold = True
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = "Off Exchange Withheld"
Range("D2").Select
Selection.Cut
Range("E2").Select
ActiveSheet.Paste
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection.Font
.Name = "ARIAL"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection.Font
.Color = -4165632
.TintAndShade = 0
End With
On Error Resume Next
Set fn = ActiveSheet.Range("A:A").Find(What:="On Exchange Commission Withheld", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
Set sh = ActiveSheet
Sheets.Add After:=Sheets(Sheets.Count)
With sh
.Range(fn, .Cells(Rows.Count, 1).End(xlUp)).EntireRow.Cut ActiveSheet.Range("A1")
End With
Columns("A:Z").Select
Selection.ColumnWidth = 30
Rows("1:1").Select
Selection.Font.Bold = True
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = "On Exchange Withheld"
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection.Font
.Name = "ARIAL"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection.Font
.Color = -4165632
.TintAndShade = 0
End With
Range("D1").Select
Selection.Cut
Range("E1").Select
ActiveSheet.Paste
On Error Resume Next
Set fn = ActiveSheet.Range("A:A").Find(What:="Off Exchange Bonus Withheld", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
Set sh = ActiveSheet
Sheets.Add After:=Sheets(Sheets.Count)
With sh
.Range(fn, .Cells(Rows.Count, 1).End(xlUp)).EntireRow.Cut ActiveSheet.Range("A1")
End With
Columns("A:Z").Select
Selection.ColumnWidth = 30
Rows("1:1").Select
Selection.Font.Bold = True
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = "Off Exchange Bonus WH"
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection.Font
.Name = "ARIAL"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection.Font
.Color = -4165632
.TintAndShade = 0
End With
Range("E1").Select
Selection.Cut
Range("D1").Select
ActiveSheet.Paste
On Error Resume Next
Set fn = ActiveSheet.Range("A:A").Find(What:="Cancelled Groups/Accounts", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
Set sh = ActiveSheet
Sheets.Add After:=Sheets(Sheets.Count)
With sh
.Range(fn, .Cells(Rows.Count, 1).End(xlUp)).EntireRow.Cut ActiveSheet.Range("A1")
End With
Columns("A:Z").Select
Selection.ColumnWidth = 30
Rows("1:1").Select
Selection.Font.Bold = True
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = "Cancelled Accts"
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection.Font
.Name = "ARIAL"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection.Font
.Color = -4165632
.TintAndShade = 0
End With
Range("A1").Select
Selection.Delete Shift:=xlToLeft
Sheets("Off Exchange Withheld").Select
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
Sheets("On Exchange Withheld").Select
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
Sheets("Off Exchange Bonus WH").Select
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End Sub
Sub BrokerAcct()
'
' Excel Macro
' Reformat Statements
'
'
Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C1").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H1").Select
Selection.Cut
Range("C1").Select
ActiveSheet.Paste
Range("D1").Select
Selection.Cut
Range("A2").Select
ActiveSheet.Paste
Range("E1").Select
Selection.Cut
Range("B2").Select
ActiveSheet.Paste
Range("J1").Select
Selection.Cut
Range("C2").Select
ActiveSheet.Paste
Range("G1").Select
Selection.Cut
Range("A3").Select
ActiveSheet.Paste
Range("F1").Select
Selection.Cut
Range("B3").Select
ActiveSheet.Paste
Range("L1").Select
Selection.Cut
Range("C3").Select
ActiveSheet.Paste
Range("I1").Select
Selection.Cut
Range("A4").Select
ActiveSheet.Paste
Range("N1").Select
Selection.Cut
Range("C4").Select
ActiveSheet.Paste
Range("K1").Select
Selection.Cut
Range("A5").Select
ActiveSheet.Paste
Range("O1").Select
Selection.Cut
Range("C5").Select
ActiveSheet.Paste
Range("M1").Select
Selection.Cut
Range("A6").Select
ActiveSheet.Paste
Range("P1").Select
Selection.Cut
Range("C6").Select
ActiveSheet.Paste
ActiveSheet.Name = "Summary"
Range("A1:C6").Select
Selection.Font.Bold = True
ActiveWindow.SmallScroll Down:=21
Rows("41:41").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("43:43").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C42:D42").Select
Selection.Cut
Range("A43").Select
ActiveSheet.Paste
Range("E42:F42").Select
Selection.Cut
Range("A44").Select
ActiveSheet.Paste
Range("G42:H42").Select
Selection.Cut
Range("A45").Select
ActiveSheet.Paste
Range("I42:J42").Select
Selection.Cut
Range("A46").Select
ActiveSheet.Paste
Range("K42:L42").Select
Selection.Cut
Range("A47").Select
ActiveSheet.Paste
Range("M42:N42").Select
Selection.Cut
Range("A48").Select
ActiveSheet.Paste
Range("O42:P42").Select
Selection.Cut
Range("A49").Select
ActiveSheet.Paste
Rows("51:55").Select
Selection.Delete Shift:=xlUp
Rows("51:51").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Sheets.Add After:=Sheets(Sheets.Count)
Range("A1").Select
ActiveSheet.Paste
Rows("1:1").Select
Selection.Font.Bold = True
Columns("A:M").Select
Selection.ColumnWidth = 30
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 2
ActiveSheet.Name = "Individual Accts"
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells.Select
With Selection.Font
.Name = "ARIAL"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection.Font
.Color = -4165632
.TintAndShade = 0
End With
Set sh = ActiveSheet
On Error Resume Next
Set fn = sh.Range("A:A").Find(What:="1-50 Group Commissions", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
Sheets.Add After:=Sheets(Sheets.Count)
sh.Range(fn, sh.Cells(Rows.Count, 1).End(xlUp)).EntireRow.Cut ActiveSheet.Range("A1")
Columns("A:Z").Select
Selection.ColumnWidth = 30
Rows("1:1").Select
Selection.Font.Bold = True
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = "1-50 Group Commissions"
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection.Font
.Name = "ARIAL"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection.Font
.Color = -4165632
.TintAndShade = 0
End With
Range("A1:B1").Select
Selection.Cut
Range("H1").Select
Selection.Insert Shift:=xlToRight
On Error Resume Next
Set fn = ActiveSheet.Range("A:A").Find(What:="51+ Group Commission", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
Set sh = ActiveSheet
Sheets.Add After:=Sheets(Sheets.Count)
With sh
.Range(fn, .Cells(Rows.Count, 1).End(xlUp)).EntireRow.Cut ActiveSheet.Range("A1")
End With
Columns("A:Z").Select
Selection.ColumnWidth = 30
Rows("1:1").Select
Selection.Font.Bold = True
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = "51+ Group Commissions"
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection.Font
.Name = "ARIAL"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection.Font
.Color = -4165632
.TintAndShade = 0
End With
Range("A1").Select
Selection.Delete Shift:=xlToLeft
On Error Resume Next
Set fn = ActiveSheet.Range("A:A").Find(What:="Exchange Individual Accounts", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
Set sh = ActiveSheet
Sheets.Add After:=Sheets(Sheets.Count)
With sh
.Range(fn, .Cells(Rows.Count, 1).End(xlUp)).EntireRow.Cut ActiveSheet.Range("A1")
End With
Columns("A:Z").Select
Selection.ColumnWidth = 30
Rows("1:1").Select
Selection.Font.Bold = True
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = "Exchange Ind Accounts"
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection.Font
.Name = "ARIAL"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection.Font
.Color = -4165632
.TintAndShade = 0
End With
On Error Resume Next
Set fn = ActiveSheet.Range("A:A").Find(What:="Exchange 1-50 Group Commissions", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
Set sh = ActiveSheet
Sheets.Add After:=Sheets(Sheets.Count)
With sh
.Range(fn, .Cells(Rows.Count, 1).End(xlUp)).EntireRow.Cut ActiveSheet.Range("A1")
End With
Columns("A:Z").Select
Selection.ColumnWidth = 30
Rows("1:1").Select
Selection.Font.Bold = True
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = "Exchange 1-50 Group Comm"
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection.Font
.Name = "ARIAL"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection.Font
.Color = -4165632
.TintAndShade = 0
End With
Range("I1:J1").Select
Selection.Cut
Range("A1").Select
Selection.Insert Shift:=xlToRight
On Error Resume Next
Set fn = ActiveSheet.Range("A:A").Find(What:="Individual New Sales Bonus", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
Set sh = ActiveSheet
Sheets.Add After:=Sheets(Sheets.Count)
With sh
.Range(fn, .Cells(Rows.Count, 1).End(xlUp)).EntireRow.Cut ActiveSheet.Range("A1")
End With
Columns("A:Z").Select
Selection.ColumnWidth = 30
Rows("1:1").Select
Selection.Font.Bold = True
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = "Indiv New Sales Bonus"
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection.Font
.Name = "ARIAL"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection.Font
.Color = -4165632
.TintAndShade = 0
End With
On Error Resume Next
Set fn = ActiveSheet.Range("A:A").Find(What:="IMD Voluntary Dental Override", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
Set sh = ActiveSheet
Sheets.Add After:=Sheets(Sheets.Count)
With sh
.Range(fn, .Cells(Rows.Count, 1).End(xlUp)).EntireRow.Cut ActiveSheet.Range("A1")
End With
Columns("A:Z").Select
Selection.ColumnWidth = 30
Rows("1:1").Select
Selection.Font.Bold = True
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = "IMD Dental Override"
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection.Font
.Name = "ARIAL"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection.Font
.Color = -4165632
.TintAndShade = 0
End With
On Error Resume Next
Set fn = ActiveSheet.Range("A:A").Find(What:="Off Exchange Commission Withheld", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
Set sh = ActiveSheet
Sheets.Add After:=Sheets(Sheets.Count)
With sh
.Range(fn, .Cells(Rows.Count, 1).End(xlUp)).EntireRow.Cut ActiveSheet.Range("A1")
End With
Columns("A:Z").Select
Selection.ColumnWidth = 30
Rows("1:1").Select
Selection.Font.Bold = True
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = "Off Exchange Withheld"
Range("D2").Select
Selection.Cut
Range("E2").Select
ActiveSheet.Paste
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection.Font
.Name = "ARIAL"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection.Font
.Color = -4165632
.TintAndShade = 0
End With
On Error Resume Next
Set fn = ActiveSheet.Range("A:A").Find(What:="On Exchange Commission Withheld", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
Set sh = ActiveSheet
Sheets.Add After:=Sheets(Sheets.Count)
With sh
.Range(fn, .Cells(Rows.Count, 1).End(xlUp)).EntireRow.Cut ActiveSheet.Range("A1")
End With
Columns("A:Z").Select
Selection.ColumnWidth = 30
Rows("1:1").Select
Selection.Font.Bold = True
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = "On Exchange Withheld"
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection.Font
.Name = "ARIAL"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection.Font
.Color = -4165632
.TintAndShade = 0
End With
Range("D1").Select
Selection.Cut
Range("E1").Select
ActiveSheet.Paste
On Error Resume Next
Set fn = ActiveSheet.Range("A:A").Find(What:="Off Exchange Bonus Withheld", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
Set sh = ActiveSheet
Sheets.Add After:=Sheets(Sheets.Count)
With sh
.Range(fn, .Cells(Rows.Count, 1).End(xlUp)).EntireRow.Cut ActiveSheet.Range("A1")
End With
Columns("A:Z").Select
Selection.ColumnWidth = 30
Rows("1:1").Select
Selection.Font.Bold = True
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = "Off Exchange Bonus WH"
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection.Font
.Name = "ARIAL"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection.Font
.Color = -4165632
.TintAndShade = 0
End With
Range("E1").Select
Selection.Cut
Range("D1").Select
ActiveSheet.Paste
On Error Resume Next
Set fn = ActiveSheet.Range("A:A").Find(What:="Cancelled Groups/Accounts", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
Set sh = ActiveSheet
Sheets.Add After:=Sheets(Sheets.Count)
With sh
.Range(fn, .Cells(Rows.Count, 1).End(xlUp)).EntireRow.Cut ActiveSheet.Range("A1")
End With
Columns("A:Z").Select
Selection.ColumnWidth = 30
Rows("1:1").Select
Selection.Font.Bold = True
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A2").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = "Cancelled Accts"
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection.Font
.Name = "ARIAL"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Rows("1:1").Select
With Selection.Font
.Color = -4165632
.TintAndShade = 0
End With
Range("A1").Select
Selection.Delete Shift:=xlToLeft
Sheets("Off Exchange Withheld").Select
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
Sheets("On Exchange Withheld").Select
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
Sheets("Off Exchange Bonus WH").Select
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End Sub