Macro code keeps getting hung up

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
520
Office Version
2019
Platform
Windows
Hello,

I have the below code that used to run fine but now it seems to be getting hung up and excel now freezes and the macro does not complete.
Any idea what could be causing this?
Thank you

Code:
 Application.ScreenUpdating = False    Application.Calculation = xlCalculationManual


    Sheets("A&R Report").Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
Sheets("Headers").Visible = True
Sheets("CY").Visible = True
Sheets("Report").Visible = True
Sheets("DATA").Visible = True


    Sheets("DATA").Select
    Cells.Select
    Selection.Copy
    Sheets("Report").Select
        Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            Columns("W:W").Select
    Selection.Replace What:="1", Replacement:="Additional", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="2", Replacement:="Reprocess", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Sheets("Weekly Reprocess").Select
    Rows("16:100000").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A16:A100000").Select
    Selection.ClearContents
    Range("A16").Select
    Sheets("CY").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    Sheets("wk 53").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    Sheets("Headers").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    Sheets("Report").Select
            Columns("N:N").Select
    Selection.TextToColumns Destination:=Range("N1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 3), TrailingMinusNumbers:=True
                    Columns("O:O").Select
    Selection.TextToColumns Destination:=Range("O1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 3), TrailingMinusNumbers:=True
            Columns("G:G").Select
    Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 3), TrailingMinusNumbers:=True
    Cells.Select
    Selection.Copy
    Sheets("CY").Select
    Range("A1").Select
    ActiveSheet.Paste


    Columns("P:V").Select
    Range("V1").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll ToRight:=-7
    Columns("J:J").Select
    Selection.Delete Shift:=xlToLeft
    Columns("F:F").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll ToRight:=-1
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("F:F").Select
    Selection.Copy
    Range("C1").Select
    ActiveSheet.Paste
    Columns("F:F").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("A:A").Select
    Selection.Copy
    Range("D1").Select
    ActiveSheet.Paste
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("F:F").Select
    Selection.Copy
    Range("D1").Select
    ActiveSheet.Paste
    Columns("F:F").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Columns("H:H").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.ColumnWidth = 79


    Cells.Select
    Cells.EntireRow.AutoFit
    Range("H4").Select
    Columns("H:H").ColumnWidth = 64.43
    Cells.Select
    Cells.EntireRow.AutoFit
    Cells.EntireColumn.AutoFit
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Cells.EntireColumn.AutoFit
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "Year"
LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
Range("N2:N" & LastRowColumnA).Formula = "=YEAR(RC[-12])"
    Range("O1").Select
    ActiveCell.FormulaR1C1 = "Y/N"
LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
Range("O2:O" & LastRowColumnA).Formula = "=IFERROR(INDEX('Weekly Reprocess'!R2C18,MATCH('Weekly Reprocess'!R2C17,RC[-1],FALSE)),""No"")"
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "Week"
LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
Range("P2:P" & LastRowColumnA).Formula = "=WEEKNUM(RC[-14],2)"
    
    Range("Q1").Select
    ActiveCell.FormulaR1C1 = "Yes/No"
 LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
Range("Q2:Q" & LastRowColumnA).Formula = "=IFERROR(INDEX('Weekly Reprocess'!R2C15,MATCH('Weekly Reprocess'!R2C14,RC[-1],FALSE)),""No"")"
    
        Range("T1").Select
    ActiveCell.FormulaR1C1 = "#W/O has been Reprocessed"
 LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
Range("T2:T" & LastRowColumnA).Formula = "=COUNTIF(C[-19],RC[-19])"


Columns("T:T").Select
    Selection.Copy
    Range("U1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("T:T").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft




    Range("J2").Select
    
    
Sheets("CY").Select
Range("A1").Select


Cells.Select
    Selection.Copy
    Sheets("wk 53").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
 Cells.Select
    LastCol = ActiveSheet.Range("a1").End(xlToRight).Column
    LastRow = ActiveSheet.Cells(1, 1).End(xlDown).Row
    Selection.AutoFilter
 ActiveSheet.Range("A1", ActiveSheet.Cells(LastRow, LastCol)).AutoFilter Field:=16, Criteria1:=Array( _
        "1", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "2", "20", "21", "22", "23", _
        "24", "25", "26", "27", "28", "29", "3", "30", "31", "32", "33", "34", "35", "36", "37", "38", _
        "39", "4", "40", "41", "42", "43", "44", "45", "46", "47", "48", "49", "5", "50", "51", "52", _
        "6", "7", "8", "9"), Operator:=xlFilterValues
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.ClearContents
    Sheets("CY").Select
    Rows("1:1").Select
    Selection.Copy
    Sheets("wk 53").Select
    Range("A1").Select
    ActiveSheet.Paste
    Columns("A:A").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Application.CutCopyMode = False
    Selection.EntireRow.Delete
    Columns("O:O").Select
    Selection.Delete Shift:=xlToLeft
    Columns("P:P").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    Sheets("CY").Select
  
Cells.Select
    LastCol = ActiveSheet.Range("a1").End(xlToRight).Column
    LastRow = ActiveSheet.Cells(1, 1).End(xlDown).Row
    Selection.AutoFilter
 ActiveSheet.Range("A1", ActiveSheet.Cells(LastRow, LastCol)).AutoFilter Field:=15, Criteria1:="No"
    Rows("1:1").Select
    Range("C1").Activate
    Selection.Copy
    Sheets("Headers").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("CY").Select
    Cells.Select
    Range("C1").Activate
    Selection.SpecialCells(xlCellTypeVisible).Select
    Application.CutCopyMode = False
    Selection.ClearContents
  Cells.Select
    LastCol = ActiveSheet.Range("a1").End(xlToRight).Column
    LastRow = ActiveSheet.Cells(1, 1).End(xlDown).Row
    Selection.AutoFilter
 ActiveSheet.Range("A1", ActiveSheet.Cells(LastRow, LastCol)).AutoFilter Field:=17, Criteria1:="No"
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.ClearContents
    Sheets("Headers").Select
    Rows("1:1").Select
    Selection.Copy
    Sheets("CY").Select
    Range("A1").Select
    ActiveSheet.Paste
    Columns("A:A").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Application.CutCopyMode = False
    Selection.EntireRow.Delete
    
    
    
    
    
    Sheets("CY").Select
    Range("R1").Select
    ActiveCell.FormulaR1C1 = "Date In-Out"
 LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
Range("R2:R" & LastRowColumnA).Formula = "=IF(COUNT(RC[-7]:RC[-6])<>2,"""",TEXT(RC[-7],""mmm dd"")&"" - ""&TEXT(RC[-6],""mmm dd""))"
    Columns("R:R").Select
    Selection.Copy
    Columns("S:S").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Columns("R:R").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
Columns("K:L").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Columns("L:O").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft


Columns("H:H").Select
    Selection.Copy
    Range("N1").Select
    ActiveSheet.Paste
    Columns("H:H").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    Range("G1").Activate
    Selection.Copy
    Sheets("A&R Report").Select
    ActiveSheet.Paste
    Range("A1").Select
    Sheets("CY").Select
    Cells.Select
    Range("G1").Activate
    Application.CutCopyMode = False
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$BS$1000000").AutoFilter Field:=10, Criteria1:= _
        "Additional"
    Rows("1:1").Select
    Selection.Copy
    Sheets("Headers").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("CY").Select
    Cells.Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Sheets("Headers").Select
    Rows("1:1").Select
    Selection.Copy
    Sheets("CY").Select
    Range("A1").Select
    ActiveSheet.Paste
    Columns("A:A").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Application.CutCopyMode = False
    Selection.EntireRow.Delete
    Columns("J:J").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select


    Range("F2:F1000000").Select
    Selection.Copy
    Range("M1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$M$1:$M$1000000").RemoveDuplicates Columns:=1, Header:=xlNo
    Selection.Copy
    Sheets("Weekly Reprocess").Select
    Range("R8").Select
    ActiveSheet.Paste
    Sheets("CY").Select
    Columns("M:M").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("G:G").Select
    Selection.Copy
    Range("D1").Select
    ActiveSheet.Paste
    Columns("E:E").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("G1").Select
    ActiveSheet.Paste
    Columns("E:E").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Columns("K:K").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("H:H").Select
    Selection.Copy
    Range("K1").Select
    ActiveSheet.Paste
    Columns("H:H").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
        Columns("E:E").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("G:G").Select
    Selection.Copy
    Range("E1").Select
    ActiveSheet.Paste
    Columns("G:G").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Columns("G:H").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("J:K").Select
    Selection.Copy
    Range("G1").Select
    ActiveSheet.Paste
    Columns("I:I").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("M:M").Select
    Selection.Copy
    Range("I1").Select
    ActiveSheet.Paste
    Columns("K:M").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select




    Range("A2:L1000000").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Weekly Reprocess").Select
    Range("B16").Select
    ActiveSheet.Paste


 If Range("B16") <> "" Then
   Msg = "Update Complete"














        Range("A15:M1000000").Select
    ActiveWorkbook.Worksheets("Weekly Reprocess").Sort.SortFields.Add Key:=Range( _
        "B16:B1000000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Weekly Reprocess").Sort
        .SetRange Range("A15:M1000000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    Range("A16").Select
    Application.CutCopyMode = False
    
ActiveCell.FormulaR1C1 = "1"
If Cells(Rows.Count, "B").End(xlUp).Row > 16 Then
    Range("A16").AutoFill Destination:=Range("A16:A" & Cells(Rows.Count, "B").End(xlUp).Row), Type:=xlFillSeries
End If




Range("A16").CurrentRegion.Select
Range("A16", Cells(Rows.Count, 1).End(xlUp)).Resize(, 13).Select


With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
Range("B16").CurrentRegion.Select
Range("B16", Cells(Rows.Count, 1).End(xlUp)).Resize(, 13).Select
    ActiveWorkbook.Worksheets("Weekly Reprocess").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Weekly Reprocess").Sort.SortFields.Add2 Key:=Range _
        ("C16:C1000000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Weekly Reprocess").Sort
        .SetRange Range("B15:M1000000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
End If
    Columns("I:I").EntireColumn.AutoFit
    Columns("L:L").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Columns("M:M").ColumnWidth = 43.14
    Columns("K:K").EntireColumn.AutoFit
    Rows("15:1000000").Select
    Rows("15:1000000").EntireRow.AutoFit
   
   Range("A15").Select
       Application.DisplayAlerts = False
   Sheets("Report").Select
    ActiveWindow.SelectedSheets.Delete
   Sheets.Add().Name = "Report"
   Application.DisplayAlerts = True
       
   Sheets("Report").Sort.SortFields.Clear
   Sheets("CY").Sort.SortFields.Clear
   Sheets("DATA").Sort.SortFields.Clear
   Sheets("Weekly Reprocess").Sort.SortFields.Clear
   Sheets("wk 53").Sort.SortFields.Clear
   Sheets("Headers").Sort.SortFields.Clear
   Sheets("A&R Report").Sort.SortFields.Clear
   
   
   Sheets("Headers").Visible = False
   Sheets("CY").Visible = False
   Sheets("Report").Visible = False
   Sheets("DATA").Visible = False
           
           Sheets("Weekly Reprocess").Select
           
           Range("A1").Select
   






If Msg = "" Then Msg = "No Results"
MsgBox Msg
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True




End Sub
 

Some videos you may like

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
520
Office Version
2019
Platform
Windows
I know my code could use some major cleaning, I am new to VBA and am still learning.
 

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
520
Office Version
2019
Platform
Windows
I looked online and followed instructions on how to debug a code (by using breaks: Debug.Print Now(), 'some marker text')
and I found that the code kept freezing at this part:

Code:
        Range("T1").Select
    ActiveCell.FormulaR1C1 = "#W/O has been Reprocessed"
 LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
Range("T2:T" & LastRowColumnA).Formula = "=COUNTIF(C[-19],RC[-19])"
Any ideas why this would be causing it to freeze or if there was a faster way?

Thank you very much!!
 

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
520
Office Version
2019
Platform
Windows
Is there a faster method of doing a count if formula?
For example: I know a Vlookup is a lot slower than using an index match. Perhaps this is the issue? Is there a more efficient formula?

Maybe I am wrong and you can see something else that is wrong with the code.

Thank you to anyone who can assist with this.
 

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
520
Office Version
2019
Platform
Windows
Actually I think it is more than just the Count if hanging up the macro. Any assistance would be greatly appreciated
 

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
520
Office Version
2019
Platform
Windows
This post can be closed. I cleaned up the code but what fixed the issue was putting in all of my formulas, getting the data results, copying those cells and pasting the data back in them as values only (removing formulas) before sorting through the data with filters or reorganizing any data.

Don't know if that will help anyone in the future but I thought I would post it.
 

Watch MrExcel Video

Forum statistics

Threads
1,099,911
Messages
5,471,468
Members
406,764
Latest member
ExcelMaker007

This Week's Hot Topics

Top