Help Debugging long sorting, labeling and highlighting macro

BG1983 · Mar 19th 2016

Hi - I keep trying to fix this macro and feel like I am making things worse. At my wits end.. any help would be appreciated with just looking and pointing out things you know for a fact are going to throw errors...

Code

' ComplaintDept Macro
'
Application.ScreenUpdating = False
Application.StatusBar = False
Application.DisplayAlerts = False
    ActiveWorkbook.Worksheets("Sheet1").Activate
        Rows("1:4").Select
            Range("A4").Activate
                Selection.Delete Shift:=xlUp
        Rows("2:2").Select
            Selection.Delete Shift:=xlUp
        Range("A1").Select
        
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlToRight)).Select
            Selection.Copy
    Sheets.Add After:=ActiveSheet
        Sheets("Sheet2").Select
        ActiveSheet.Paste
        Selection.RowHeight = 15
        Cells.Select
            Cells.EntireColumn.AutoFit
        Range("A2").Select
            Rows("2:2").EntireRow.AutoFit
    Sheets("Sheet1").Select
        Application.CutCopyMode = False
        ActiveWindow.SelectedSheets.Delete
        ActiveWorkbook.Worksheets("Sheet2").Activate
    Columns("D:D").Select
    Selection.FormatConditions.Add Type:=xlTextString, String:="Sample", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    ActiveSheet.Range("A$1:$AI10000").AutoFilter Field:=4, Criteria1:=RGB(255 _
    , 199, 206), Operator:=xlFilterCellColor
    Cells.Select
    ActiveSheet.Range("$A$1:$AI10000").Offset(1, 0).SpecialCells _
    (xlCellTypeVisible).EntireRow.Delete
    ActiveSheet.ShowAllData
    Cells.Select
    ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A10000" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet2").Sort
        .SetRange Range("A1:AI15000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
        ActiveSheet.Range("$A1:$AI15000").RemoveDuplicates Columns:=1, Header:= _
        xlYes
        Cells.Select
        With Selection.Font
        .Name = "Arial"
        .Size = 9
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("$AJ$1").Select
    ActiveCell.FormulaR1C1 = "Status Bucket"
    Selection.AutoFilter
    
Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    
Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("A5").CurrentRegion, , xlYes).Name = "Table"
     Rows("1:1").EntireRow.AutoFit
    Columns("A:C").EntireColumn.AutoFit
    Range("A1:AI1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Rows("1:1").RowHeight = 41.25
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("B2").Select
    ActiveWindow.FreezePanes = True
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=23, Criteria1:="<>"
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range("$AJ").SpecialCells(xlCellTypeVisible).FormulaR1C1 = "Complaint Sent To Court - Not Filed"
    ActiveSheet.ShowAllData
'
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=23, Criteria1:="="
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=21, Criteria1:="<>"
    Range("AJ2:AJ" & lr).SpecialCells(xlCellTypeVisible).FormulaR1C1 = "Verified Received - Not Sent"
    ActiveSheet.ShowAllData
'
'
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=21, Criteria1:="="
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=19, Criteria1:="<>"
    Range("AJ2:AJ" & lr).SpecialCells(xlCellTypeVisible).FormulaR1C1 = "Complaint Sent to Client - Not Received"
    ActiveSheet.ShowAllData
 '
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=19, Criteria1:="="
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=18, Criteria1:="<>"
    Range("$AJ2:$AJ" & lr).SpecialCells(xlCellTypeVisible).FormulaR1C1 = "Complaint Prepared - Not Sent"
    ActiveSheet.ShowAllData
'
'
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=18, Criteria1:="="
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=12, Criteria1:="<>"
    Range("$AJ2:$AJ" & lr).SpecialCells(xlCellTypeVisible).FormulaR1C1 = "Pending Complaint Prep"
    ActiveSheet.ShowAllData
'
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=12, Criteria1:="="
    Range("$AJ2:$AJ" & lr).SpecialCells(xlCellTypeVisible).FormulaR1C1 = "Pending Title Exam"
    ActiveSheet.ShowAllData
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=27, Criteria1:=Array( _
    "Appointment for a Guardian Ad-Litem/Probate", "Awtg BKY Pleading Validation", "Awtg Consumer Response", _
    "Awtg Dual Track Review", "Awtg Fee Approval", "Awtg Figures", "Awtg Filed Order", "Awtg Filed Pleading", _
    "Awtg FPOC", "Awtg Funds Received", "Awtg Instructions from Client to Proceed", "Awtg LMM Portal", _
    "Awtg Plan Confirmation", "Awtg Referral", "Awtg Standing Clarification", "Fair Debt Dispute", _
    "HOA Review", "Mediation", "New Referral Requested", "Payment Dispute", "Pending BK Review", "RESPA", "Sale Cancellation", _
    "Sale Moratorium", "Sale Rescission", "Sale Reset/PP", "Third Party Ligation", "Title Defect", "Title Defect Lender Managed", "Vesting Issue"), _
    Operator:=xlFilterValues
    Range("$AJ1:$AJ" & lr).SpecialCells(xlCellTypeVisible).FormulaR1C1 = "Delayed"
'
    ActiveSheet.ShowAllData
    Columns("AH").ColumnWidth = 39
    Rows("1:1").Select
    Selection.RowHeight = 76.5
    Rows("1:1").Select
    With Selection
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("M").ColumnWidth = 16
    Columns("P").ColumnWidth = 16
    Columns("Q:T").ColumnWidth = 16
    Columns("U").ColumnWidth = 16
    Columns("X").ColumnWidth = 16
    Columns("AE:AF").ColumnWidth = 16
    Columns("V:V").ColumnWidth = 24
    Columns("AH:AH").ColumnWidth = 47
    ActiveSheet.Range("AJ1:AJ" & lr).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = True
    Selection.AutoFilter
    Columns("AA").ColumnWidth = 36
    Columns("S").ColumnWidth = 10
    Columns("I").ColumnWidth = 10
    Columns("I").ColumnWidth = 15
    Columns("D").ColumnWidth = 35
    Columns("E").ColumnWidth = 26
    Rows("1:1").Select
    Selection.AutoFilter
'
   On Error Resume Next
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=27, Criteria1:= _
    "Reforeclosure", Operator:=xlOr, Criteria2:="="
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range("$A$1:$AJ$" & lr).Offset(1, 0).SpecialCells _
    (xlCellTypeVisible).EntireRow.Delete
   ActiveSheet.ShowAllData
      On Error Resume Next
      ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=23, Criteria1:="="
      ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=21, Criteria1:="<>"
      If ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.SpecialCells(xlCellTypeVisible).Count > 0 Then
            Range("$U1:$U" & lr).SpecialCells(xlCellTypeVisible).Select
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 255
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
        ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.SpecialCells(xlCellTypeVisible).Select
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 255
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
    Else: ActiveSheet.ShowAllData
        End If
'
    ActiveSheet.ShowAllData
    On Error Resume Next
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=23, Criteria1:="="
        ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=21, Criteria1:="<>"
            ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=19, Criteria1:="<>"
        If ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.SpecialCells(xlCellTypeVisible).Count > 0 Then
            ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range("S1:S").SpecialCells(xlCellTypeVisible).Select
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 255
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
            ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.SpecialCells(xlCellTypeVisible).Select
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 255
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
        Else: ActiveSheet.ShowAllData
        End If
'
    ActiveSheet.ShowAllData
    On Error Resume Next
        ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=23, Criteria1:="="
            ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=21, Criteria1:="<>"
                ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=19, Criteria1:="<>"
                    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=18, Criteria1:="<>"
        If ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.SpecialCells(xlCellTypeVisible).Count > 0 Then
            ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range("$R1:$R" & lr).SpecialCells(xlCellTypeVisible).Select
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 255
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
            ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range("$A1:$A" & lr).SpecialCells(xlCellTypeVisible).Select
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 255
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
    Else: ActiveSheet.ShowAllData
    End If
'

Display More

BG1983 · Mar 19th 2016

Re: Help Debugging long sorting, labeling and highlighting macro

2nd part of code..

Code

[COLOR=#333333] ActiveSheet.ShowAllData[/COLOR]    On Error Resume Next
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=23, Criteria1:="="
        ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=21, Criteria1:="<>"
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=19, Criteria1:="<>"
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=18, Criteria1:="<>"
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=12, Criteria1:="<>"
        If ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.SpecialCells(xlCellTypeVisible).Count > 0 Then
            ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range("$L1:$L" & lr).SpecialCells(xlCellTypeVisible).Select
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 255
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
            ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range("$A1:$A" & lr).SpecialCells(xlCellTypeVisible).Select
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 255
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
            Else: ActiveSheet.ShowAllData
        End If
'
    ActiveSheet.ShowAllData
    On Error Resume Next
        ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=21, Criteria1:="="
            ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=19, Criteria1:="<>"
            If ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.SpecialCells(xlCellTypeVisible).Count > 0 Then
                ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range("$S1:$S" & lr).SpecialCells(xlCellTypeVisible).Select
                    With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 255
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
            ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range("$A1:$A" & lr).SpecialCells(xlCellTypeVisible).Select
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 255
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
            Else: ActiveSheet.ShowAllData
        End If
'
    ActiveSheet.ShowAllData
    On Error Resume Next
        ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=21, Criteria1:="="
            ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=19, Criteria1:="<>"
                ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=18, Criteria1:="<>"
            If ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.SpecialCells(xlCellTypeVisible).Count > 0 Then
                ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range("$R1:$R" & lr).SpecialCells(xlCellTypeVisible).Select
                    With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 255
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                Range("$A1:$A" & lr).SpecialCells(xlCellTypeVisible).Select
                    With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 255
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                Else: ActiveSheet.ShowAllData
            End If
'
    ActiveSheet.ShowAllData
    On Error Resume Next
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=21, Criteria1:="="
        ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=19, Criteria1:="<>"
            ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=18, Criteria1:="<>"
                ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=12, Criteria1:="<>"
            If ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.SpecialCells(xlCellTypeVisible).Count > 0 Then
                ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range("$L1:$L" & lr).SpecialCells(xlCellTypeVisible).Select
                    With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 255
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                         End With
                ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range("$A1:$A" & lr).SpecialCells(xlCellTypeVisible).Select
                    With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 255
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                Else: ActiveSheet.ShowAllData
            End If
'
    ActiveSheet.ShowAllData
    On Error Resume Next
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=19, Criteria1:="="
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=18, Criteria1:="<>"
        If ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.SpecialCells(xlCellTypeVisible).Count > 0 Then
            ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range("$R1:$R" & lr).SpecialCells(xlCellTypeVisible).Select
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 255
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
            Range("$A1:$A" & lr).SpecialCells(xlCellTypeVisible).Select
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 255
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
            Else: ActiveSheet.ShowAllData
        End If
'
    ActiveSheet.ShowAllData
    On Error Resume Next
        ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=19, Criteria1:="="
            ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=18, Criteria1:="<>"
                ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=12, Criteria1:="<>"
            If ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.SpecialCells(xlCellTypeVisible).Count > 0 Then
                ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range("$L1:$L" & lr).SpecialCells(xlCellTypeVisible).Select
                    With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 255
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                     End With
            ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range("$A1:$A" & lr).SpecialCells(xlCellTypeVisible).Select
                With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 255
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
            Else: ActiveSheet.ShowAllData
         End If
'
    ActiveSheet.ShowAllData
    On Error Resume Next
        ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=18, Criteria1:="="
            ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=12, Criteria1:="<>"
                If ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.SpecialCells(xlCellTypeVisible).Count > 0 Then
                    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range("$L1:$L" & lr).SpecialCells(xlCellTypeVisible).Select
                    With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 255
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.SpecialCells(xlCellTypeVisible).Select
                    With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 255
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
            Else: ActiveSheet.ShowAllData
    End If
'
    ActiveSheet.ShowAllData
    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=1, Criteria1:=RGB(255 _
        , 0, 0), Operator:=xlFilterCellColor
    Sheets("Sheet2").Select
    Sheets("Sheet2").Copy After:=Sheets(2)
    Sheets("Sheet2 (2)").Select
    Range("$A1:$A").AutoFilter Field:=1, Operator:= _
        xlFilterNoFill
    Rows("1:1").Select
    Selection.EntireRow.Hidden = True
    Selection.SpecialCells(xlCellTypeVisible).Select
            Selection.Delete Shift:=xlUp
    ActiveWorkbook.Worksheets("Sheet2 (2)").AutoFilter.Sort.SortFields.Clear
    ActiveSheet.ShowAllData
    Rows("1:1").Select
    Selection.EntireRow.Hidden = False
    Sheets("Sheet2 (2)").Name = "Missing Dates"
    Cells.Select
    Sheets("Sheet2").Name = "Complaint Dept. Report"
    Sheets("Complaint Dept. Report").Select
    Cells.Select
Application.ScreenUppdating = True
Application.StatusBar = True
Application.DisplayAlerts = True [COLOR=#333333]End Sub
[/COLOR]

Display More

Grimes0332 · Mar 19th 2016

Re: Help Debugging long sorting, labeling and highlighting macro

Your post is a very good example of how not to post on a board like this.

You say "I keep trying to fix this macro" but you don't say what the issue(s) are.
You attach an XLSX workbook which cannot contain code.

If anyone was to attempt to help, they'd have to download the workbook, copy/paste the code (from the looks of it, about 450 lines) and then edit it to get rid of any extra text from the message before running the code and dealing with any compile issues and only then trying to figure out what your problems are - and odds on whatever they might find will be something you haven't even come across.

You would increase your chance of getting some help if you upload a complete, working XLSM file, invest some time explaining clearly what the problems are and what it is you want the code to do.

The only advice I would give is get rid of the

Code

On Error Resume Next

statements and correctly deal with any errors that do get raised; including potential errors like a filter not returning any rows, rather than just ignoring them. Errors will compound upon errors leaving you completely lost by the time it actually falls over - and when it does the eventual error will completely mask the initial problem that started the error cascade.

BG1983 · Mar 19th 2016

Re: Help Debugging long sorting, labeling and highlighting macro

Okay. Sorry about that. Attached is the document with the code.

I am getting an error at line 126 - Invalid procedure call or argument

What I am trying to do at that point is filter out the data and input text into the visible cells in column AJ depending on the filtering..

so,

Code

ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range.AutoFilter Field:=23, Criteria1:="<>"    ActiveWorkbook.Sheets("Sheet2").ListObjects("Table").Range("$AJ$").SpecialCells(xlCellTypeVisible).FormulaR1C1 = "Complaint Sent To Court - Not Filed"
    ActiveSheet.ShowAllData
'

Here, I am filtering on column 23 and if it not blank, I am putting in "Complaint Sent To Court - Not Filed" - for everything that is visible. At the end of all of this i am going to create a pivot using the descriptions from column AJ.

I have attached a better example doc, with the code.

Thanks

Help Debugging long sorting, labeling and highlighting macro

Participate now!

Share