Hi all,
Here's my two subs
Both subs work exactly as intended when ran separately. However, when I combine them as below the function of the second sub halts and I'm not sure why.. though I'm suspicious of it being something to do with the GoTo 0 error handling lines. No error is thrown when the combined macro runs, it just doesn't do as its told.
Any suggestions?
Thanks!
Here's my two subs
VBA Code:
Sub Sort1() 'Initial sort
Dim ws As Worksheet
Dim rng As Range
Set ws = Worksheets(2)
With ws
'Formats times
.Columns("K:L").NumberFormat = "hh:mm"
'Removes entries with no data in A
On Error Resume Next
ws.Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
'Removes entries with no data in M
On Error Resume Next
ws.Columns("M").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
End With
End Sub
Sub BreakFixer()
Dim ws As Worksheet
Dim rng As Range
Set ws = Worksheets(2)
Set rng = ws.Range("M1", ws.Range("M1").End(xlDown))
With ws
.Range("R1").Formula2R1C1 = _
"=CEILING(RC[-7]:INDEX(C[-7],COUNTA(C[-7]))-TIME(0,7,30),TIME(0,15,0))"
.Range("R1", ws.Range("R1").End(xlDown)).Copy
.Range("K1").PasteSpecial xlPasteValues
.Range("R1", ws.Range("R1").End(xlDown)).Clear
For Each Cell In rng
If Cell.Value = "Br" Then Cell.Offset(1, -2).Value = Cell.Offset(0, -2).Value + TimeValue("00:15:00")
Next
End With
End Sub
Both subs work exactly as intended when ran separately. However, when I combine them as below the function of the second sub halts and I'm not sure why.. though I'm suspicious of it being something to do with the GoTo 0 error handling lines. No error is thrown when the combined macro runs, it just doesn't do as its told.
VBA Code:
Sub Sort1() 'Initial sort of All Activity
Dim ws As Worksheet
Dim rng As Range
Set ws = Worksheets(2)
Set rng = ws.Range("M1", ws.Range("M1").End(xlDown))
With ws
'Formats start and end times
.Columns("K:L").NumberFormat = "hh:mm"
'Removes entries with no Employee Number
On Error Resume Next
ws.Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
'Removes entries with no activity/absence codes
On Error Resume Next
ws.Columns("M").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
.Range("R1").Formula2R1C1 = _
"=CEILING(RC[-7]:INDEX(C[-7],COUNTA(C[-7]))-TIME(0,7,30),TIME(0,15,0))"
.Range("R1", ws.Range("R1").End(xlDown)).Copy
.Range("K1").PasteSpecial xlPasteValues
.Range("R1", ws.Range("R1").End(xlDown)).Clear
For Each Cell In rng
If Cell.Value = "Br" Then Cell.Offset(1, -2).Value = Cell.Offset(0, -2).Value + TimeValue("00:15:00")
Next
End With
End Sub
Any suggestions?
Thanks!