Hi all,
My data is downloaded from another program & needs reformatting/sorting to extract the relevant data. Part of the procedure is for one sub to delete non essential columns and the following applies a date format to other columns... and then continue with subsequent routines. When run in test mode, or individually, the results are as expected. However, when all macros are called, the second runs before the first completes, corrupting the results. I have tried including Do Events at various places in the routine, but without success. I could swap the order they are called as a work-around, but I would like to understand how to overcome the problem for future reference. Any ideas/explanation how to force the first to complete before the second runs?
Code as follows:
followed by
My data is downloaded from another program & needs reformatting/sorting to extract the relevant data. Part of the procedure is for one sub to delete non essential columns and the following applies a date format to other columns... and then continue with subsequent routines. When run in test mode, or individually, the results are as expected. However, when all macros are called, the second runs before the first completes, corrupting the results. I have tried including Do Events at various places in the routine, but without success. I could swap the order they are called as a work-around, but I would like to understand how to overcome the problem for future reference. Any ideas/explanation how to force the first to complete before the second runs?
Code as follows:
Code:
Sub MT09_DeleteEmptyColumnsWithHeader()
Dim Col As Long, ColCnt As Long, Rng As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
DoEvents
On Error GoTo Exits:
If Selection.Columns.Count > 1 Then
Set Rng = Selection
Else
Set Rng = Range(Columns(1), Columns(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column()))
End If
ColCnt = 0
For Col = Rng.Columns.Count To 2 Step -1
If Application.WorksheetFunction.CountA(Rng.Columns(Col).EntireColumn) < 2 Then
Rng.Columns(Col).EntireColumn.Delete
ColCnt = ColCnt + 1
End If
Next Col
Exits:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
DoEvents
End Subfollowed by
Code:
Sub MT10_FormatDates()
Dim FX1 As String
Dim FX2 As String
Dim FX3 As String
Dim FX4 As String
Dim FX5 As String
Dim FX6 As String
FX1 = "=SUBSTITUTE((K2),""."",""/"")"
FX2 = "=SUBSTITUTE((L2),""."",""/"")"
FX3 = "=SUBSTITUTE((M2),""."",""/"")"
FX4 = "=IFERROR(IF(ISBLANK(P2),"""",DATEVALUE(P2)),"""")"
FX5 = "=DATEVALUE(Q2)"
FX6 = "=DATEVALUE(R2)"
With Sheets("Delivery On Time")
Application.ScreenUpdating = False
.Range("K1:M1").Copy
.Range("S1:U1").PasteSpecial
.Range("P2:P" & .Cells(.Rows.Count, "A").End(xlUp).Row).Formula = FX1
.Range("Q2:Q" & .Cells(.Rows.Count, "A").End(xlUp).Row).Formula = FX2
.Range("R2:R" & .Cells(.Rows.Count, "A").End(xlUp).Row).Formula = FX3
.Range("S2:S" & .Cells(.Rows.Count, "A").End(xlUp).Row).Formula = FX4
.Range("T2:T" & .Cells(.Rows.Count, "A").End(xlUp).Row).Formula = FX5
.Range("U2:U" & .Cells(.Rows.Count, "A").End(xlUp).Row).Formula = FX6
Columns("S:U").Copy
Columns("K:M").PasteSpecial xlPasteValues
.Range("A:U").Sort Key1:=Range("J2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Columns("K:M").NumberFormat = "m/d/yyyy"
Columns("P:U").Delete Shift:=xlToLeft
End With
End Sub