willow1985
Well-known Member
- Joined
- Jul 24, 2019
- Messages
- 929
- Office Version
- 365
- Platform
- Windows
I have the below code. It used to work fine but suddenly when I run it it will start to run fine but at the end it will display the message box "update complete" but the entire workbook is frozen and grayed out/parts of text everywhere etc. However the macro works fine if I run it straight from VB: Macros, view Macro, Step into, Run OR Macros, view macro, Select the Macro, Run.
I have tried deleting the button and re-creating it but I still get the same problem. Any idea what could be causing the freezing / how to fix it?
I have tried deleting the button and re-creating it but I still get the same problem. Any idea what could be causing the freezing / how to fix it?
Code:
Sub MWRefresh()'
' MWRefresh Macro
'
Worksheets("Monthly Warranties").Unprotect Password:="SADIE"
Worksheets("Report").Unprotect Password:="SADIE"
Sheets("Monthly Warranties").Select
Range("A13:H300").Select
Application.CutCopyMode = False
Selection.ClearContents
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
Sheets("MW Data").Visible = True
Sheets("Report").Select
Cells.Select
Selection.Copy
Sheets("MW Data").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("B:B").Select
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 3), TrailingMinusNumbers:=True
Selection.NumberFormat = "[$-409]d-mmm-yy;@"
Cells.Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells.EntireColumn.AutoFit
Range("O2").Select
Columns("C:D").Select
Selection.Delete Shift:=xlToLeft
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
Selection.Copy
Columns("H:H").Select
ActiveSheet.Paste
Columns("F:F").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("H:H").Select
Selection.Delete Shift:=xlToLeft
Range("J1").Select
ActiveCell.FormulaR1C1 = "Month Match"
Range("K1").Select
ActiveCell.FormulaR1C1 = "Year Match"
Range("J2").Select
LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
Range("J2:J" & LastRowColumnA).Formula = "=IFERROR(INDEX('Monthly Warranties'!R2C12,MATCH('Monthly Warranties'!R2C7,'MW Data'!RC[-2],FALSE)),""No"")"
LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
Range("K2:K" & LastRowColumnA).Formula = "=IFERROR(INDEX('Monthly Warranties'!R4C12,MATCH('Monthly Warranties'!R4C6,'MW Data'!RC[-2],FALSE)),""No"")"
Cells.Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$P$127").AutoFilter Field:=11, Criteria1:="Yes"
ActiveSheet.Range("$A$1:$P$127").AutoFilter Field:=10, Criteria1:="Yes"
Columns("A:G").Select
Range("G1").Activate
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Monthly Warranties").Select
Range("B13").Select
ActiveSheet.Paste
Rows("13:13").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range("A13").Select
Application.CutCopyMode = False
If Range("B13") <> "" Then
Msg = "Update Complete"
ActiveCell.FormulaR1C1 = "1"
If Cells(Rows.Count, "B").End(xlUp).Row > 13 Then
Range("A13").AutoFill Destination:=Range("A13:A" & Cells(Rows.Count, "B").End(xlUp).Row), Type:=xlFillSeries
End If
Range("A13").Select
Sheets("MW Data").Select
Cells.Select
Selection.AutoFilter
Selection.Delete Shift:=xlUp
Range("A1").Select
Sheets("MW Data").Visible = False
Sheets("Monthly Warranties").Select
Columns("A:A").Select
With Selection
.HorizontalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
Range("A13:H" & LastRowColumnA).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
Columns("H:H").ColumnWidth = 31.57
Range("H13:H300").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
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("13:300").Select
Rows("13:300").EntireRow.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("A:A").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
End If
Worksheets("Report").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True, Password:="SADIE"
Worksheets("Monthly Warranties").Protect Password:="SADIE"
Range("A13").Select
If Msg = "" Then Msg = "No Results"
MsgBox Msg
'
End Sub
Last edited: