Please Help! New to VBA- Need Error Handling For Multiple "Find" Commands

G

Galapagos15

Board Regular
Joined
Sep 16, 2015
Messages
100
The coding below is basically "Finding" key words and then cutting and pasting that section of data to other tabs. If one of the "Find" key words is missing how do I tell it to continue onto the next "Find" command so the coding will continue to run it's course? The "Find" key words are 1-50 Group Commissions, 51+ Group Commission, Exchange Individual Accounts and Cancelled Groups/Accounts. Thanks in advance!
Code: 
Sub BrokerAcct()	
'	
' Excel Macro	
' Reformat Statements	
'	
'	
Set sh = ActiveSheet	
 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")	
ActiveSheet.Name = "1-50 Group Commissions"	
        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	
ActiveSheet.Name = "51+ Group Commissions"	
        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	
ActiveSheet.Name = "Exchange Ind Accounts"	
        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	
ActiveSheet.Name = "Cancelled Accts"	
            End If	
    End If	
    End If	
    End If	
End Sub
 
Last edited by a moderator:

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Sort by date Sort by votes
Hi!
Are you thinking you will have only one instance of each, only one out of the 4 possibilities, or are you saying there could be multiple cases of each (though not assuredly) ?

There are multiple ways to solve this, but the answer to the above will decide which ways to choose...
 
Upvote 0
Hello, thank you so much for responding! No, there will only be one instance of each of the "Find" key words.
 
Upvote 0
OK, while there may be a more elegant way to do this, I looked at your code and what I THINK you are trying to do, I have written code to accomplish:
Code: 
Sub BRevised()
Dim sh As Worksheet, LastRow As Integer, LastCol As Integer
Dim fn As Range, x As Integer, k$, l$, m$, n$
'----Shortcuts! Dim k$ = Dim k as string----
Set sh = ActiveSheet
Application.ScreenUpdating = False
'-----speeds things up-----
x = ThisWorkbook.Sheets.Count
k = "1-50 Group Commissions"
l = "51+ Group Commission"
m = "Exchange Individual Accounts"
n = "Cancelled Groups/Accounts"
With sh
    LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    LastCol = .Cells(1, Columns.Count).End(xlUp).Column
End With
'On Error Resume Next
Set fn = Rows("1").Find(What:=k, _
    LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
    Range(fn, Cells(LastRow, fn.Column)).Copy
    Sheets.Add After:=Sheets(x)
    With ActiveSheet
        .Name = k
        .Range("A1").Select
        Selection.PasteSpecial (xlPasteAll)
        .Range("A1").Select
    End With
    Application.CutCopyMode = False
End If
sh.Activate


Set fn = Rows("1").Find(What:=l, _
    LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
    Range(fn, Cells(LastRow, fn.Column)).Copy
    Sheets.Add After:=Sheets(x)
    With ActiveSheet
        .Name = l
        .Range("A1").Select
        Selection.PasteSpecial (xlPasteAll)
        .Range("A1").Select
    End With
    Application.CutCopyMode = False
End If
sh.Activate


Set fn = Rows("1").Find(What:=m, _
    LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
    Range(fn, Cells(LastRow, fn.Column)).Copy
    Sheets.Add After:=Sheets(x)
    With ActiveSheet
        .Name = m
        .Range("A1").Select
        Selection.PasteSpecial (xlPasteAll)
        .Range("A1").Select
    End With
    Application.CutCopyMode = False
End If
sh.Activate


Set fn = Rows("1").Find(What:=n, _
    LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows)
If Not fn Is Nothing Then
    Range(fn, Cells(LastRow, fn.Column)).Copy
    Sheets.Add After:=Sheets(x)
    With ActiveSheet
        .Name = n
        .Range("A1").Select
        Selection.PasteSpecial (xlPasteAll)
        .Range("A1").Select
    End With
    Application.CutCopyMode = False
End If
sh.Activate
Application.ScreenUpdating = False


End Sub

This looks at your main sheet (fn), and finds each of the search terms. When it finds "search term", it copies the column in which that is found, copies it into a new sheet at the end of the workbook, and calls that sheet "search term". Then it goes back to fn and looks for the next search term, and does the same.
 
Upvote 0
Thank you for the feedback. For some reason I got the following error "LastRow = .Cells(Rows.Count, 1).End(xlUp).Row" when I ran you coding. Basically, this is a statement that was imported into Excel and is on one tab. The statement needs to be reformatted and broken out by the different broker product sections such as 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. The coding below works perfectly but if the statement doesn't have one of the products listed above then it doesn't finish. I need to add some commands that will tell it to continue to the next "Find" command if one of the products above isn't there. I would appreciate any suggestions.
Code: 
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	
 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	
        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	
        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	
        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	
        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	
        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	
        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	
        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	
        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	
        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
 
Last edited by a moderator:
Upvote 0
I'm glad you've discovered the macro recorder... man, does it make code hard to read, though!

This is so much more complicated than I was expecting. My initial macro is nothing like what I THINK you might be doing - sorry, I have no idea how to help.
 
Upvote 0
It looks like your End If statements are in the wrong place. You need to close the If Not fn is nothing block before you test the next find:

Rich (BB code): 
    Set fn = sh.Range("A:A").Find(What:="1-50 Group Commissions", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows)
    If Not fn Is Nothing Then

' your code to copy etc goes here

End If

    Set fn = ActiveSheet.Range("A:A").Find(What:="51+ Group Commission", LookIn:=xlFormulas, _
                                           LookAt:=xlPart, SearchOrder:=xlByRows)
    If Not fn Is Nothing Then

' more processing code

End If

and so on.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
Excel macros extremely slow
Replies
4
Views
236
Shloime
S
O
  • Question
Running through a Config and pulling out the relevant information using keywords into smaller sheets
Replies
0
Views
167
oitbc
O
C
  • Solved
VBA - Checking for Duplicates
Replies
2
Views
172
cwhaley1
C
N
  • Question
My code is suddenly really slow
Replies
1
Views
181
RobP
R
SanjayGMusafir
  • Solved
VBA to search Excel by Field Input Values
Replies
3
Views
319
kevin9999
K

Forum statistics

Threads
1,216,167
Messages
6,129,263
Members
449,497
Latest member
The Wamp

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top