Dashboard Macro Bug & Adjustment

E

EvdM

New Member
Joined
Dec 2, 2020
Messages
24
Office Version
  1. 365
Platform
  1. Windows
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?

1608302049946.png


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.

1608301743218.png


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
 

Attachments

  • 1608301664301.png
    1608301664301.png
    40.5 KB · Views: 6

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Sort by date Sort by votes
You must log in or register to reply here.

Similar threads

S
  • Question Question
Xlookup on multiple columns Filtering
Replies
2
Views
535
scottishbigyin
S
W
  • Solved
Looking For Tips To Improve My VBA
Replies
8
Views
198
who am i
W
S
  • Question Question
Multiple columns lookup
Replies
0
Views
262
Sipirili2504
S
S
  • Question Question
Macro for
Replies
2
Views
96
Sanderb
S
M
  • Question Question
VBA Subtotal 47,000+ Rows
Replies
1
Views
230
igold
igold

Forum statistics

Threads
1,223,911
Messages
6,175,333
Members
452,636
Latest member
laura12345

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top