B
Brooks
I'm trying to get the following macro to run only once --
I've assigned the macro to a button, but I'm afraid
someone will accidently click the button twice:
Sub PA_ONLY()
Columns("H:M").Select
Range("H2").Activate
Selection.NumberFormat = "m/d/yy"
Rows("5:5").Select
Selection.Insert Shift:=xlDown
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="-1"
Range("C62000").Select
Selection.ClearContents
Range("G6:M2000").Select
Selection.ClearContents
Rows("6:2000").Select
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
Range("A6").Select
ActiveCell.FormulaR1C1 = "=MID(RC[5],10,2)"
Range("A6").Select
Selection.Copy
Range("A6:A2000").Select
ActiveSheet.Paste
Range("C5").Select
Application.CutCopyMode = False
Selection.AutoFilter Field:=3, Criteria1:=">0",
Operator:=xlAnd
Range("A7").Select
ActiveCell.FormulaR1C1 = "=IF(R[-1]C[1]=RC[1],R[-1]
C,"""")"
Range("A7").Select
Selection.Copy
Range("A7:A2000").Select
ActiveSheet.Paste
Range("C5").Select
Application.CutCopyMode = False
Selection.AutoFilter Field:=3
Range("A6:A2000").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Selection.AutoFilter
Rows("5:5").Select
Selection.Delete Shift:=xlUp
Columns("N:O").Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.AddIndent = False
.ShrinkToFit = False
End With
Columns("F:F").Select
Range("F2").Activate
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
End With
Range("G2:G4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 90
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
Range("D24").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 90
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
Range("A2:A4").Select
End Sub
I've assigned the macro to a button, but I'm afraid
someone will accidently click the button twice:
Sub PA_ONLY()
Columns("H:M").Select
Range("H2").Activate
Selection.NumberFormat = "m/d/yy"
Rows("5:5").Select
Selection.Insert Shift:=xlDown
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="-1"
Range("C62000").Select
Selection.ClearContents
Range("G6:M2000").Select
Selection.ClearContents
Rows("6:2000").Select
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
Range("A6").Select
ActiveCell.FormulaR1C1 = "=MID(RC[5],10,2)"
Range("A6").Select
Selection.Copy
Range("A6:A2000").Select
ActiveSheet.Paste
Range("C5").Select
Application.CutCopyMode = False
Selection.AutoFilter Field:=3, Criteria1:=">0",
Operator:=xlAnd
Range("A7").Select
ActiveCell.FormulaR1C1 = "=IF(R[-1]C[1]=RC[1],R[-1]
C,"""")"
Range("A7").Select
Selection.Copy
Range("A7:A2000").Select
ActiveSheet.Paste
Range("C5").Select
Application.CutCopyMode = False
Selection.AutoFilter Field:=3
Range("A6:A2000").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Selection.AutoFilter
Rows("5:5").Select
Selection.Delete Shift:=xlUp
Columns("N:O").Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.AddIndent = False
.ShrinkToFit = False
End With
Columns("F:F").Select
Range("F2").Activate
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
End With
Range("G2:G4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 90
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
Range("D24").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 90
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
Range("A2:A4").Select
End Sub