Macro code keeps getting hung up

willow1985

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
886
Office Version
  1. 365
Platform
  1. 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
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Sort by date Sort by votes
I know my code could use some major cleaning, I am new to VBA and am still learning.
 
Upvote 0
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!!
 
Upvote 0
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.
 
Upvote 0
Actually I think it is more than just the Count if hanging up the macro. Any assistance would be greatly appreciated
 
Upvote 0
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.
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question
Help with Vba Code
Replies
3
Views
146
Coyotex3
C
J
  • Question
Issue with Macros and renaming files
Replies
6
Views
478
kevin9999
K
R
  • Solved
How to loop a macro
Replies
2
Views
349
rlcurlee
R
C
  • Question
How to get my macro to stop at the last recognized line
Replies
6
Views
195
Coco1
C
L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
317
RoryA
RoryA

Forum statistics

Threads
1,214,530
Messages
6,120,071
Members
448,943
Latest member
sharmarick

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