ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Macro Crashes (https://www.excelbanter.com/excel-programming/337564-macro-crashes.html)

ineedhelp2[_3_]
Macro Crashes
 

The macro below crashes on me, I think b/c of my subtotaling of the
employee information. Can someone help me clean this up, and make it
run, and not crash. Thanks.


Code:
--------------------

Sub SortForm()
'
' SortForm Macro

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Range("A1").Select
Sheets("EMPLOYEE").Select
Sheets.Add
Sheets("Sheet4").Select
Sheets("Sheet4").Move After:=Sheets(5)
Sheets("Sheet4").Select
Sheets("Sheet4").Name = "DEPT SUMMARY"
Range("A1").Select
ActiveCell.FormulaR1C1 = "OT DEPARTMENT SUMMARY"
Range("A1").Select
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With Selection.Font
.Name = "Arial"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("A2").Select
ActiveCell.FormulaR1C1 = "='Org Data'!R[-1]C[1]"
Range("A2").Select
Selection.Copy
Application.CutCopyMode = False
Selection.Cut
Range("B2").Select
ActiveSheet.Paste
Range("A2").Select
ActiveCell.FormulaR1C1 = "Date:"
Range("A2:B2").Select
Range("B2").Activate
Selection.Font.Bold = True
Range("A4").Select
Columns("A:A").ColumnWidth = 13.86
ActiveCell.FormulaR1C1 = "DEPARTMENT"
Range("B4").Select
ActiveCell.FormulaR1C1 = "AMOUNT $"
Range("C4").Select
ActiveCell.FormulaR1C1 = "AMOUNT HOURS"
Range("A4:C4").Select
Range("C4").Activate
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Columns("A:A").ColumnWidth = 14.57
Columns("B:B").ColumnWidth = 11.71
Columns("C:C").ColumnWidth = 13.14
Range("A4:C4").Select
Range("C4").Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Range("A6").Select
ActiveCell.FormulaR1C1 = "Police"
Range("A7").Select
ActiveCell.FormulaR1C1 = "Fire/EMS"
Range("A8").Select
ActiveCell.FormulaR1C1 = "Sheriff"
Range("A9").Select
ActiveCell.FormulaR1C1 = "Corrections"
Range("A10").Select
ActiveCell.FormulaR1C1 = "Homeland Security"
Range("A11").Select
Columns("A:A").ColumnWidth = 16
Range("B6").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R[-4]C[6]:R[29994]C[6],(MATCH(""50 Total"",DEPT!R[-4]C[1]:R[29994]C[1],0)),1)"
Range("B6").Select
Selection.NumberFormat = "#,##0"
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R2C8:R30000C8,(MATCH(""50 Total"",DEPT!R2C3:R30000C3,0)),1)"
Range("B6").Select
Selection.AutoFill Destination:=Range("B6:B10"), Type:=xlFillDefault
Range("B6:B10").Select
Range("B7").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R2C8:R30000C8,(MATCH(""50 Total"",DEPT!R2C3:R30000C3,0)),1)"
Range("B9").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R2C8:R30000C8,(MATCH(""56 Total"",DEPT!R2C3:R30000C3,0)),1)"
Range("B7").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R2C8:R30000C8,(MATCH(""51 Total"",DEPT!R2C3:R30000C3,0)),1)"
Range("B8").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R2C8:R30000C8,(MATCH(""55 Total"",DEPT!R2C3:R30000C3,0)),1)"
Range("B9").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R2C8:R30000C8,(MATCH(""5 Total"",DEPT!R2C3:R30000C3,0)),1)"
Range("B6:B10").Select
Selection.AutoFill Destination:=Range("B6:C10"), Type:=xlFillDefault
Range("B6:C10").Select
Range("C6").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R2C9:R30000C9,(MATCH(""50 Total"",DEPT!R2C3:R30000C3,0)),1)"
Range("C7").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R2C9:R30000C9,(MATCH(""51 Total"",DEPT!R2C3:R30000C3,0)),1)"
Range("C8").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R2C9:R30000C9,(MATCH(""55 Total"",DEPT!R2C3:R30000C3,0)),1)"
Range("C9").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R2C9:R30000C9,(MATCH(""5 Total"",DEPT!R2C3:R30000C3,0)),1)"
Range("C10").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R2C9:R30000C9,(MATCH(""50 Total"",DEPT!R2C3:R30000C3,0)),1)"
Range("C11").Select
Sheets("DEPT SUMMARY").Select
Sheets.Add
Sheets("Sheet5").Select
Sheets("Sheet5").Name = "EMPLOYEES+1k"
Range("A1").Select
Sheets("EMPLOYEE").Select
Range("A1:K1").Select
Selection.Copy
Sheets("EMPLOYEES+1k").Select
ActiveSheet.Paste
Columns("K:K").ColumnWidth = 10.43
Range("A3").Select
Columns("A:A").ColumnWidth = 16
Columns("A:A").ColumnWidth = 17.43
Columns("F:G").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("F3").Select
ActiveCell.FormulaR1C1 = ""
Range("F4").Select
Sheets("EMPLOYEE").Select
Cells.Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=RIGHT($A2,5)=""Total"""
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
End With

End Sub

--------------------


--
ineedhelp2
------------------------------------------------------------------------
ineedhelp2's Profile: http://www.excelforum.com/member.php...o&userid=26298
View this thread: http://www.excelforum.com/showthread...hreadid=396644

Rowan[_2_]
Macro Crashes
 
Without telling us which line your macro crashes on you leave us guessing a
bit as to what the problem is. So my guess:

I think the problem is with the Sheet naming. When you recorded the macro
the sheets added were called Sheet4 and Sheet5. Next time you run the macro
they will probably be called Sheet6 and Sheet7 and hence not be recognised by
the macro lines using the old names eg Sheets("Sheet4").Name = "DEPT
SUMMARY".

I have done some cleaning this up so that it should now run. There is still
some work to do with regard to adding missing formulas and changing the
format condiditons on the EMPLOYEE sheet but this should get you started.

Sub SortForm()

' SortForm Macro
Dim NSht As Worksheet
Dim NSht2 As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set NSht = Sheets.Add
With NSht
.Move After:=Sheets(5)
.Name = "DEPT SUMMARY"
With Range("A1")
.Value = "OT DEPARTMENT SUMMARY"
.Font.Bold = True
.Font.Size = 11
End With
.Range("B2").FormulaR1C1 = "='Org Data'!R[-1]C"
.Range("A2").Value = "Date:"

.Range("A2:B2").Font.Bold = True
With Range("A4:C4")
.Value = Array("DEPARTMENT", "AMOUNT $", "AMOUNT HOURS")
.Font.Bold = True
.Borders(xlEdgeBottom).Weight = xlMedium
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With

.Columns("A:A").ColumnWidth = 16
.Columns("B:B").ColumnWidth = 11.71
.Columns("C:C").ColumnWidth = 14.5
.Range("A6") = "Police"
.Range("A7") = "Fire/EMS"
.Range("A8") = "Sheriff"
.Range("A9") = "Corrections"
.Range("A10") = "Homeland Security"
.Range("B6:C10").NumberFormat = "#,##0"
.Range("B6").FormulaR1C1 = "=INDEX(DEPT!R2C8:R30000C8," _
& "(MATCH(""50 Total"",DEPT!R2C3:R30000C3,0)),1)"
.Range("B7").FormulaR1C1 = "=INDEX(DEPT!R2C8:R30000C8," _
& "(MATCH(""51 Total"",DEPT!R2C3:R30000C3,0)),1)"
.Range("B8").FormulaR1C1 = "=INDEX(DEPT!R2C8:R30000C8," _
& "(MATCH(""55 Total"",DEPT!R2C3:R30000C3,0)),1)"
.Range("B9").FormulaR1C1 = "=INDEX(DEPT!R2C8:R30000C8," _
& "(MATCH(""5 Total"",DEPT!R2C3:R30000C3,0)),1)"
'add correct formula for B10
.Range("C6").FormulaR1C1 = "=INDEX(DEPT!R2C9:R30000C9," _
& "(MATCH(""50 Total"",DEPT!R2C3:R30000C3,0)),1)"
.Range("C7").FormulaR1C1 = "=INDEX(DEPT!R2C9:R30000C9," _
& "(MATCH(""51 Total"",DEPT!R2C3:R30000C3,0)),1)"
.Range("C8").FormulaR1C1 = "=INDEX(DEPT!R2C9:R30000C9," _
& "(MATCH(""55 Total"",DEPT!R2C3:R30000C3,0)),1)"
.Range("C9").FormulaR1C1 = "=INDEX(DEPT!R2C9:R30000C9," _
& "(MATCH(""5 Total"",DEPT!R2C3:R30000C3,0)),1)"
'add correct formula for C10

End With

Set NSht2 = Sheets.Add
With NSht2
.Name = "EMPLOYEES+1k"
Sheets("EMPLOYEE").Range("A1:K1").Copy _
Destination:=.Range("A1")
.Columns("K:K").ColumnWidth = 10.43
.Columns("A:A").ColumnWidth = 17.43
.Columns("F:G").Delete Shift:=xlToLeft
End With

' continue to change EMPLOYEE format condidtions etc

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Hope this helps
Rowan

PS Instead of using Index and Match you could use a vlookup formulas to
bring through the totals.

"ineedhelp2" wrote:


The macro below crashes on me, I think b/c of my subtotaling of the
employee information. Can someone help me clean this up, and make it
run, and not crash. Thanks.


Code:
--------------------

Sub SortForm()
'
' SortForm Macro

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Range("A1").Select
Sheets("EMPLOYEE").Select
Sheets.Add
Sheets("Sheet4").Select
Sheets("Sheet4").Move After:=Sheets(5)
Sheets("Sheet4").Select
Sheets("Sheet4").Name = "DEPT SUMMARY"
Range("A1").Select
ActiveCell.FormulaR1C1 = "OT DEPARTMENT SUMMARY"
Range("A1").Select
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With Selection.Font
.Name = "Arial"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("A2").Select
ActiveCell.FormulaR1C1 = "='Org Data'!R[-1]C[1]"
Range("A2").Select
Selection.Copy
Application.CutCopyMode = False
Selection.Cut
Range("B2").Select
ActiveSheet.Paste
Range("A2").Select
ActiveCell.FormulaR1C1 = "Date:"
Range("A2:B2").Select
Range("B2").Activate
Selection.Font.Bold = True
Range("A4").Select
Columns("A:A").ColumnWidth = 13.86
ActiveCell.FormulaR1C1 = "DEPARTMENT"
Range("B4").Select
ActiveCell.FormulaR1C1 = "AMOUNT $"
Range("C4").Select
ActiveCell.FormulaR1C1 = "AMOUNT HOURS"
Range("A4:C4").Select
Range("C4").Activate
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Columns("A:A").ColumnWidth = 14.57
Columns("B:B").ColumnWidth = 11.71
Columns("C:C").ColumnWidth = 13.14
Range("A4:C4").Select
Range("C4").Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Range("A6").Select
ActiveCell.FormulaR1C1 = "Police"
Range("A7").Select
ActiveCell.FormulaR1C1 = "Fire/EMS"
Range("A8").Select
ActiveCell.FormulaR1C1 = "Sheriff"
Range("A9").Select
ActiveCell.FormulaR1C1 = "Corrections"
Range("A10").Select
ActiveCell.FormulaR1C1 = "Homeland Security"
Range("A11").Select
Columns("A:A").ColumnWidth = 16
Range("B6").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R[-4]C[6]:R[29994]C[6],(MATCH(""50 Total"",DEPT!R[-4]C[1]:R[29994]C[1],0)),1)"
Range("B6").Select
Selection.NumberFormat = "#,##0"
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R2C8:R30000C8,(MATCH(""50 Total"",DEPT!R2C3:R30000C3,0)),1)"
Range("B6").Select
Selection.AutoFill Destination:=Range("B6:B10"), Type:=xlFillDefault
Range("B6:B10").Select
Range("B7").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R2C8:R30000C8,(MATCH(""50 Total"",DEPT!R2C3:R30000C3,0)),1)"
Range("B9").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R2C8:R30000C8,(MATCH(""56 Total"",DEPT!R2C3:R30000C3,0)),1)"
Range("B7").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R2C8:R30000C8,(MATCH(""51 Total"",DEPT!R2C3:R30000C3,0)),1)"
Range("B8").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R2C8:R30000C8,(MATCH(""55 Total"",DEPT!R2C3:R30000C3,0)),1)"
Range("B9").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R2C8:R30000C8,(MATCH(""5 Total"",DEPT!R2C3:R30000C3,0)),1)"
Range("B6:B10").Select
Selection.AutoFill Destination:=Range("B6:C10"), Type:=xlFillDefault
Range("B6:C10").Select
Range("C6").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R2C9:R30000C9,(MATCH(""50 Total"",DEPT!R2C3:R30000C3,0)),1)"
Range("C7").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R2C9:R30000C9,(MATCH(""51 Total"",DEPT!R2C3:R30000C3,0)),1)"
Range("C8").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R2C9:R30000C9,(MATCH(""55 Total"",DEPT!R2C3:R30000C3,0)),1)"
Range("C9").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R2C9:R30000C9,(MATCH(""5 Total"",DEPT!R2C3:R30000C3,0)),1)"
Range("C10").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(DEPT!R2C9:R30000C9,(MATCH(""50 Total"",DEPT!R2C3:R30000C3,0)),1)"
Range("C11").Select
Sheets("DEPT SUMMARY").Select
Sheets.Add
Sheets("Sheet5").Select
Sheets("Sheet5").Name = "EMPLOYEES+1k"
Range("A1").Select
Sheets("EMPLOYEE").Select
Range("A1:K1").Select
Selection.Copy
Sheets("EMPLOYEES+1k").Select
ActiveSheet.Paste
Columns("K:K").ColumnWidth = 10.43
Range("A3").Select
Columns("A:A").ColumnWidth = 16
Columns("A:A").ColumnWidth = 17.43
Columns("F:G").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("F3").Select
ActiveCell.FormulaR1C1 = ""
Range("F4").Select
Sheets("EMPLOYEE").Select
Cells.Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=RIGHT($A2,5)=""Total"""
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
End With

End Sub

--------------------


--
ineedhelp2
------------------------------------------------------------------------
ineedhelp2's Profile: http://www.excelforum.com/member.php...o&userid=26298
View this thread: http://www.excelforum.com/showthread...hreadid=396644


All times are GMT +1. The time now is 01:32 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com