Hi VBA Specialist,
I run a macro every morning to see the status of the project. (code below)
It opens every statusfile of a factory, reads out the important values and sums it up in a dashboard.
The macro should only fill untill column V, but it also (over)rights a 0 in column W.
Does anybody know why this is happening and how I can avoid it?
Second, there is this adjustment I would like to make:
When they didn't start the testing as you see here in the example, It still shows the values of assets that has been measured in the past (Colomn G, J, U and V).
In the example below can you see the 420200 that is counted because everything is measured (Column T all Nein/No).
Where the 420209 only partly is tested and another part still has to be done, is not been counted.
I would like to remove the assets that not need to be inspected out of column G, J, U, and V.
Hopefully this is a quick fix for somebody.
Thanks in advance,
Edwin van der Mijl
Code of the macro:
I run a macro every morning to see the status of the project. (code below)
It opens every statusfile of a factory, reads out the important values and sums it up in a dashboard.
The macro should only fill untill column V, but it also (over)rights a 0 in column W.
Does anybody know why this is happening and how I can avoid it?
Second, there is this adjustment I would like to make:
When they didn't start the testing as you see here in the example, It still shows the values of assets that has been measured in the past (Colomn G, J, U and V).
In the example below can you see the 420200 that is counted because everything is measured (Column T all Nein/No).
Where the 420209 only partly is tested and another part still has to be done, is not been counted.
I would like to remove the assets that not need to be inspected out of column G, J, U, and V.
Hopefully this is a quick fix for somebody.
Thanks in advance,
Edwin van der Mijl
Code of the macro:
VBA Code:
Sub CallAll()
Application.ScreenUpdating = False
Application.Calculation = xlManual
Call SetupMod.SetupProg
Call Progmod.SetupBCBLandBU
Call Progmod.SetupExecutionStatus
'Call Progmod.WeeklyKPI
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub
Sub SetupBCBLandBU()
BCBLWS.Range(BCBLWS.Cells(2, 1), BCBLWS.Cells(999999, 20)).ClearContents
BUWS.Range(BUWS.Cells(3, 1), BUWS.Cells(999999, 16)).ClearContents
Dim UnitNo As Integer
Dim CircCount As Double
Dim LineCount As Double
Dim CircCountComp As Double
Dim LineCountComp As Double
Dim SuccessBool As Boolean
Dim SaveBool As Boolean
Dim CircRecCount As Double
Dim CircTabCount As Double
Dim CircFlagCount As Double
Dim CircRevCount As Double
Dim FoundLine As Boolean
Dim FoundCirc As Boolean
Dim LineRevCount As Double
Do While ProgWS.Cells(ProgSpot, 1) <> ""
UnitNo = ProgWS.Cells(ProgSpot, 1)
WKBSpot = 4
Set WKB = Workbooks.Open(ProgWS.Cells(ProgSpot, 2))
Set WKBWS = WKB.Sheets("Beauftragung")
CircCount = 0
LineCount = 0
LineCountComp = 0
CircCountComp = 0
SuccessBool = False
SaveBool = False
CircRecCount = 0
CircTabCount = 0
CircFlagCount = 0
CircRevCount = 0
LineRevCount = 0
BLSpot = 2
Do While BCBLWS.Cells(BLSpot, 12) <> ""
BLSpot = BLSpot + 1
Loop
BCSpot = 2
Do While BCBLWS.Cells(BCSpot, 1) <> ""
BCSpot = BCSpot + 1
Loop
Do While WKBWS.Cells(WKBSpot, 5) <> ""
If WKBWS.Cells(WKBSpot, 9) <> WKBWS.Cells(WKBSpot - 1, 9) Then 'increase circuit spot (including the first time) if the circuit does not match the previous circuit
If BCSpot <> 1 Then
BCBLWS.Cells(BCSpot, 3) = CircCount
BCBLWS.Cells(BCSpot, 4) = CircCountComp
BCBLWS.Cells(BCSpot, 5) = CircRecCount
BCBLWS.Cells(BCSpot, 6) = CircTabCount
BCBLWS.Cells(BCSpot, 7) = CircFlagCount
BCBLWS.Cells(BCSpot, 8) = CircRevCount
End If
BCSpot = 2
FoundCirc = False
Do While BCBLWS.Cells(BCSpot, 1) <> "" And FoundCirc = False
If BCBLWS.Cells(BCSpot, 1) = UnitNo And BCBLWS.Cells(BCSpot, 2) = WKBWS.Cells(WKBSpot, 9) Then
FoundCirc = True
Else
BCSpot = BCSpot + 1
End If
Loop
If BCBLWS.Cells(BCSpot, 1) = "" Then
BCBLWS.Cells(BCSpot, 1) = UnitNo
BCBLWS.Cells(BCSpot, 2) = WKBWS.Cells(WKBSpot, 9)
BCBLWS.Cells(BCSpot, 9) = "=IF(RC[-5]=RC[-6],TRUE,FALSE)"
CircCount = 0
CircCountComp = 0
CircRecCount = 0
CircTabCount = 0
CircFlagCount = 0
CircRevCount = 0
Else
CircCount = BCBLWS.Cells(BCSpot, 3)
CircCountComp = BCBLWS.Cells(BCSpot, 4)
CircRecCount = BCBLWS.Cells(BCSpot, 5)
CircTabCount = BCBLWS.Cells(BCSpot, 6)
CircFlagCount = BCBLWS.Cells(BCSpot, 7)
CircRevCount = BCBLWS.Cells(BCSpot, 8)
End If
End If
If WKBWS.Cells(WKBSpot, 5) <> WKBWS.Cells(WKBSpot - 1, 5) Then 'increase line spot (including the first time) if the circuit does not match the previous circuit
If BLSpot <> 1 Then
BCBLWS.Cells(BLSpot, 13) = LineCount
BCBLWS.Cells(BLSpot, 14) = LineCountComp
BCBLWS.Cells(BLSpot, 16) = SuccessBool
BCBLWS.Cells(BLSpot, 17) = SaveBool
BCBLWS.Cells(BLSpot, 18) = LineRevCount
End If
a = 2
FoundLine = False
Do While BCBLWS.Cells(a, 12) <> "" And FoundLine = False
If BCBLWS.Cells(a, 12) = WKBWS.Cells(WKBSpot, 5) Then
FoundLine = True
Else
a = a + 1
End If
Loop
BLSpot = a
BCBLWS.Cells(BLSpot, 11) = UnitNo
BCBLWS.Cells(BLSpot, 12) = WKBWS.Cells(WKBSpot, 5)
BCBLWS.Cells(BLSpot, 15) = "=IF(RC[-1]=RC[-2],TRUE,FALSE)"
BCBLWS.Cells(BLSpot, 19) = "=IF(RC[-6]=RC[-1],TRUE,FALSE)"
BCBLWS.Cells(BLSpot, 20) = "=IF(RC[-2]>0,TRUE,IF(AND(RC[-7]=0,RC[-2]=0),TRUE,FALSE))"
LineCount = 0
LineCountComp = 0
SaveBool = False
SuccessBool = False
LineRevCount = 0
End If
If WKBWS.Cells(WKBSpot, 19) = "Ja" Then
If WKBWS.Cells(WKBSpot, 26) <> "" Then
LineCountComp = LineCountComp + 1
CircCountComp = CircCountComp + 1
End If
If WKBWS.Cells(WKBSpot, 30) = "Ja" Then
CircRecCount = CircRecCount + 1
End If
If WKBWS.Cells(WKBSpot, 34) = "Ja" Then
CircTabCount = CircTabCount + 1
End If
'If WKBWS.Cells(WKBSpot, 24) = "Yes" Then
' CircFlagCount = CircFlagCount + 1
'End If
If WKBWS.Cells(WKBSpot, 31) = "Ja" Then
CircRevCount = CircRevCount + 1
LineRevCount = LineRevCount + 1
End If
'If WKBWS.Cells(WKBSpot, 28) = "Yes" Then
' SaveBool = True
'End If
'If WKBWS.Cells(WKBSpot, 29) = "Yes" Then
' SuccessBool = True
'End If
CircCount = CircCount + 1
LineCount = LineCount + 1
End If
WKBSpot = WKBSpot + 1
Loop
BCBLWS.Cells(BCSpot, 3) = CircCount
BCBLWS.Cells(BCSpot, 4) = CircCountComp
BCBLWS.Cells(BLSpot, 13) = LineCount
BCBLWS.Cells(BLSpot, 14) = LineCountComp
BCBLWS.Cells(BLSpot, 18) = LineRevCount
BCBLWS.Cells(BCSpot, 5) = CircRecCount
BCBLWS.Cells(BCSpot, 6) = CircTabCount
BCBLWS.Cells(BCSpot, 7) = CircFlagCount
BCBLWS.Cells(BCSpot, 8) = CircRevCount
BCBLWS.Cells(BLSpot, 16) = SuccessBool
BCBLWS.Cells(BLSpot, 17) = SaveBool
BUWS.Cells(BUSpot, 1) = UnitNo
BUWS.Cells(BUSpot, 2) = "=COUNTIF('By Circuit By Line'!C[9],RC[-1])"
BUWS.Cells(BUSpot, 3) = "=COUNTIFs('By Circuit By Line'!C[-2],RC[-2],'By Circuit By Line'!C[-1]," & (Chr(34)) & "<>-" & (Chr(34)) & ")"
BUWS.Cells(BUSpot, 4) = "=SUMIF('By Circuit By Line'!C[-3],RC[-3],'By Circuit By Line'!C[-1])"
BUWS.Cells(BUSpot, 5) = "=COUNTIFS('By Circuit By Line'!C[6],RC[-4],'By Circuit By Line'!C[10],TRUE)"
BUWS.Cells(BUSpot, 6) = "=COUNTIFS('By Circuit By Line'!C[-5],RC[-5],'By Circuit By Line'!C[3],TRUE)"
BUWS.Cells(BUSpot, 7) = "=SUMIF('By Circuit By Line'!C[-6],RC[-6],'By Circuit By Line'!C[-3])"
BUWS.Cells(BUSpot, 8) = "=SUMIF('By Circuit By Line'!C1,RC1,'By Circuit By Line'!C[-3])"
BUWS.Cells(BUSpot, 9) = "=SUMIF('By Circuit By Line'!C1,RC1,'By Circuit By Line'!C[-3])"
BUWS.Cells(BUSpot, 10) = "=SUMIF('By Circuit By Line'!C1,RC1,'By Circuit By Line'!C[-3])"
BUWS.Cells(BUSpot, 11) = "=SUMIF('By Circuit By Line'!C1,RC1,'By Circuit By Line'!C[-3])"
BUWS.Cells(BUSpot, 12) = "=COUNTIFS('By Circuit By Line'!C[-1],RC[-11],'By Circuit By Line'!C[5],TRUE)"
BUWS.Cells(BUSpot, 13) = "=COUNTIFS('By Circuit By Line'!C[-2],RC[-12],'By Circuit By Line'!C[3],TRUE)"
BUWS.Cells(BUSpot, 14) = Application.WorksheetFunction.CountIfs(WKBWS.Columns(19), "Ja", WKBWS.Columns(29), "Ja", WKBWS.Columns(30), "<>Ja")
BUWS.Cells(BUSpot, 15) = "=COUNTIFS('By Circuit By Line'!C[-4],RC[-14],'By Circuit By Line'!C[4],TRUE)"
BUWS.Cells(BUSpot, 16) = "=COUNTIFS('By Circuit By Line'!C[-5],RC[-15],'By Circuit By Line'!C[4],TRUE)"
BLSpot = BLSpot + 1
BCSpot = BCSpot + 1
BUSpot = BUSpot + 1
WKB.Close False
ProgSpot = ProgSpot + 1
Loop
End Sub
Sub SetupExecutionStatus()
Set ExStatWKB = Workbooks.Open(ProgWS.Cells(2, 4), False)
Set ExStatWS = ExStatWKB.Sheets("Inspection Management Status")
Dim OriginalFileName As String
OriginalFileName = ExStatWKB.Name
Application.DisplayAlerts = False
ExStatWKB.SaveAs ProgWS.Cells(2, 7) & OriginalFileName, accessmode:=xlExclusive, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
Application.DisplayAlerts = True
Dim ColSpot As Integer
Dim FoundUnit As Boolean
BUSpot = 3
Do While BUWS.Cells(BUSpot, 1) <> ""
ExStatSpot = 5
FoundUnit = False
Do While ExStatWS.Cells(ExStatSpot, 5) <> "" And FoundUnit = False
If ExStatWS.Cells(ExStatSpot, 5) = BUWS.Cells(BUSpot, 1) Then
For ColSpot = 2 To 16
ExStatWS.Cells(ExStatSpot, BUWS.Cells(2, ColSpot)) = BUWS.Cells(BUSpot, ColSpot)
Next ColSpot
FoundUnit = True
End If
ExStatSpot = ExStatSpot + 1
Loop
BUSpot = BUSpot + 1
Loop
Dim NewFileName As String
If Month(Now()) < 10 Then
If Day(Now()) < 10 Then
NewFileName = ProgWS.Cells(3, 4) & "CMIP-Execution-Status_" & Year(Now()) & "0" & Month(Now()) & "0" & Day(Now())
Else
NewFileName = ProgWS.Cells(3, 4) & "CMIP-Execution-Status_" & Year(Now()) & "0" & Month(Now()) & Day(Now())
End If
Else
If Day(Now()) < 10 Then
NewFileName = ProgWS.Cells(3, 4) & "CMIP-Execution-Status_" & Year(Now()) & Month(Now()) & "0" & Day(Now())
Else
NewFileName = ProgWS.Cells(3, 4) & "CMIP-Execution-Status_" & Year(Now()) & Month(Now()) & Day(Now())
End If
End If
ExStatWKB.Close True, NewFileName
End Sub
Sub WeeklyKPI()
Dim TodayDate As String
TodayDate = Month(Now()) & "/" & Day(Now()) & "/" & Year(Now())
If wKPI.Cells(1, 5) <> TodayDate Then
wKPI.Columns(5).Insert shift:=xlToRight
wKPI.Cells(1, 5) = TodayDate
End If
If totKPI.Cells(1, 5) <> TodayDate Then
totKPI.Columns(5).Insert shift:=xlToRight
totKPI.Cells(1, 5) = TodayDate
End If
a = 3
Do While BUWS.Cells(a, 1) <> ""
Call Progmod.isHCUTAR(BUWS.Cells(a, 1))
If HCUTAR = True Then
totKPI.Cells(KPISpot, 5) = BUWS.Cells(a, 4)
wKPI.Cells(KPISpot, 5) = totKPI.Cells(KPISpot, 5) - totKPI.Cells(KPISpot, 6)
totKPI.Cells(KPIinsSpot, 5) = BUWS.Cells(a, 7)
wKPI.Cells(KPIinsSpot, 5) = totKPI.Cells(KPIinsSpot, 5) - totKPI.Cells(KPIinsSpot, 6)
totKPI.Cells(KPIPercSpot, 5) = totKPI.Cells(KPIinsSpot, 5) / totKPI.Cells(KPISpot, 5)
wKPI.Cells(KPIPercSpot, 5) = totKPI.Cells(KPIPercSpot, 5)
TARCMLHandoff = totKPI.Cells(KPISpot, 5) + TARCMLHandoff
TARCMLInsTotal = totKPI.Cells(KPIinsSpot, 5) + TARCMLInsTotal
Else
KPISpot = 16
KPIinsSpot = 30
totKPI.Cells(KPISpot, 5) = BUWS.Cells(a, 4)
totKPI.Cells(KPIinsSpot, 5) = BUWS.Cells(a, 7)
CMLHandoffOther = totKPI.Cells(KPISpot, 5) + CMLHandoffOther
CMLInsOther = totKPI.Cells(KPIinsSpot, 5) + CMLInsOther
End If
CircHandoffIMS = CircHandoffIMS + BUWS.Cells(a, 3)
a = a + 1
Loop
CMLHandoffTotal = CMLHandoffOther + TARCMLHandoff
CMLInsTotal = TARCMLInsTotal + CMLInsOther
CMLInsPercTotal = CMLInsTotal / CMLHandoffTotal
TARInsPerc = TARCMLInsTotal / TARCMLHandoff
totKPI.Cells(43, 5) = TARInsPerc
wKPI.Cells(43, 5) = TARInsPerc
totKPI.Cells(31, 5) = CMLInsPercTotal
wKPI.Cells(31, 5) = CMLInsPercTotal
totKPI.Cells(30, 5) = CMLInsOther
wKPI.Cells(30, 5) = totKPI.Cells(30, 5) - totKPI.Cells(30, 6)
totKPI.Cells(29, 5) = TARCMLInsTotal
wKPI.Cells(29, 5) = totKPI.Cells(29, 5) - totKPI.Cells(29, 6)
totKPI.Cells(17, 5) = CMLInsTotal
wKPI.Cells(17, 5) = totKPI.Cells(17, 5) - totKPI.Cells(17, 6)
totKPI.Cells(16, 5) = CMLHandoffOther
wKPI.Cells(16, 5) = totKPI.Cells(16, 5) - totKPI.Cells(16, 6)
totKPI.Cells(15, 5) = TARCMLHandoff
wKPI.Cells(15, 5) = totKPI.Cells(15, 5) - totKPI.Cells(15, 6)
totKPI.Cells(3, 5) = CMLHandoffTotal
wKPI.Cells(3, 5) = totKPI.Cells(3, 5) - totKPI.Cells(3, 6)
totKPI.Cells(2, 5) = CircHandoffIMS
wKPI.Cells(2, 5) = totKPI.Cells(2, 5) - totKPI.Cells(2, 6)
End Sub
Sub test()
Call SetupMod.SetupProg
Call Progmod.WeeklyKPI
End Sub
Sub isHCUTAR(ByVal UnitNo As String)
HCUTAR = False
If UnitNo = 120 Then
HCUTAR = True
KPISpot = 4
KPIinsSpot = 18
KPIPercSpot = 32
ElseIf UnitNo = 125 Then
HCUTAR = True
KPISpot = 5
KPIinsSpot = 19
KPIPercSpot = 33
ElseIf UnitNo = 231 Then
HCUTAR = True
KPISpot = 6
KPIinsSpot = 20
KPIPercSpot = 34
ElseIf UnitNo = 1518 Then
HCUTAR = True
KPISpot = 7
KPIinsSpot = 21
KPIPercSpot = 35
ElseIf UnitNo = 1520 Then
HCUTAR = True
KPISpot = 8
KPIinsSpot = 22
KPIPercSpot = 36
ElseIf UnitNo = 1521 Then
HCUTAR = True
KPISpot = 9
KPIinsSpot = 23
KPIPercSpot = 37
ElseIf UnitNo = 1522 Then
HCUTAR = True
KPISpot = 10
KPIinsSpot = 24
KPIPercSpot = 38
ElseIf UnitNo = 1527 Then
HCUTAR = True
KPISpot = 11
KPIinsSpot = 25
KPIPercSpot = 39
ElseIf UnitNo = 1528 Then
HCUTAR = True
KPISpot = 12
KPIinsSpot = 26
KPIPercSpot = 40
ElseIf UnitNo = 1529 Then
HCUTAR = True
KPISpot = 13
KPIinsSpot = 27
KPIPercSpot = 41
ElseIf UnitNo = 1539 Then
HCUTAR = True
KPISpot = 14
KPIinsSpot = 28
KPIPercSpot = 42
End If
End Sub