How do you fix VBA code that counts 1 too many?

user_16533558 0
Viewed 101

I have written a program that counts bins that are empty (verified), empty (unverified), and not accessible (bins locked).

I am trying to count the bins that are locked from my Bin Conversions sheet that if they are TRUE (there are 20 that are true), then they are locked and will be counted on my Bin Report sheet.

My Bin Reports sheet counts 1 too many for each group (all groups total 23 instead of 20). A group example would be 4-Pallet, 2.5ft, 2 bins locked (instead of 1).

Bin Report
enter image description here

Bin Conversions
enter image description here

Sub getBinStatusArray()
calc (False)

Dim dSH As Worksheet
Dim brSH As Worksheet
Dim bcSH As Worksheet
Set dSH = ThisWorkbook.Sheets("data")
Set brSH = ThisWorkbook.Sheets("Bin Report")
Set bcSH = ThisWorkbook.Sheets("Bin Conversions")

Dim binLockCell As Byte, binType As String, binSize As Variant, binLocked As Boolean, b As Long, i As Long
Dim dataArray() As Variant

Dim binIDArray As Variant

'Create empty array cells
ReDim Preserve dataArray(1 To dSH.Range("A" & Rows.Count).End(xlUp).Row, 1 To 3)

'Navigates cells
With dSH
    lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
    dataArray = .Range(.Cells(lastrow, 1), .Cells(1, 
    .Columns.Count).End(xlToLeft)).Value
End With

'Count Bin Conversion Cells
With bcSH
    lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastrow
        .Range("E" & i).Value2 = Application.WorksheetFunction.CountIf(dSH.Range("A:A"), .Range("A" & i).Value2)
    Next i
End With

'Generate Bin Report
With brSH
    .Cells.ClearContents
    .Range("H1").Value = "Filter Input"
    .Range("B1").Value = "Bin Type"
    .Range("I1").Value = "Bin Type"
    .Range("C1").Value = "Bin Height"
    .Range("J1").Value = "Bin Height"
    .Range("D1").Value = "Verified"
    .Range("K1").Value = "Verified"
    .Range("E1").Value = "Unverified"
    .Range("L1").Value = "Unverified"
    .Range("F1").Value = "Bins Locked"
    .Range("M1").Value = "Bins Locked"
    
    For i = 2 To lastrow
        If bcSH.Range("E" & i).Value = 1 Or Application.WorksheetFunction.CountIfs(bcSH.Range("G" & i), "true") Then
            binType = bcSH.Range("B" & i).Value
            binSize = bcSH.Range("C" & i).Value
            binLocked = bcSH.Range("H" & i).Value
        
            If .Range("b2") = "" Then
                .Range("b2").Value = bcSH.Range("B" & i).Value
                .Range("c2").Value = bcSH.Range("C" & i).Value
                .Range("F2").Value2 = Application.WorksheetFunction.CountIfs(bcSH.Range("G" & i), "true")
        
            ElseIf .Range("b2") <> "" Then
                lastrow = brSH.Cells(Rows.Count, 2).End(xlUp).Row
                For b = 2 To lastrow + 1
                    If brSH.Range("B" & b) = binType And brSH.Range("C" & b) = binSize Then
                        brSH.Range("D" & b) = brSH.Range("D" & b) + bcSH.Range("E" & i)
                        binLockCell = Application.WorksheetFunction.CountIfs(bcSH.Range("G" & i), "true")
                        brSH.Range("F" & b) = binLockCell + brSH.Range("F" & b)
                        Exit For
                
                    ElseIf b = lastrow Then
                        .Range("b" & b + 1).Value = bcSH.Range("B" & i).Value
                        .Range("c" & b + 1).Value = bcSH.Range("c" & i).Value
                        .Range("D" & b + 1).Value = bcSH.Range("E" & i).Value
                        binLockCell = Application.WorksheetFunction.CountIfs(bcSH.Range("G" & i), "true")
                        .Range("F" & b + 1) = binLockCell + .Range("F" & b + 1)
                    End If
                Next b
               
            End If

        End If

    Next i

    Range("b1").CurrentRegion.sort key1:=Range("b1"), order1:=xlAscending, _
      key2:=Range("C1"), order2:=xlAscending, Header:=xlYes
End With
calc (True)
End Sub
vba excel
1 Answers

You are looping For b = 2 To lastrow + 1 but adding a new line when b = lastrow i.e. before the loop has ended. So on the last iteration when b = lastrow + 1 it summates the record again. One fix would be use a flag.

 ElseIf .Range("b2") <> "" Then
        Dim bExists: bExists = False
        lastrow = brSH.Cells(Rows.Count, 2).End(xlUp).Row
        ' increment existing
        For b = 2 To lastrow
            If brSH.Range("B" & b) = binType And brSH.Range("C" & b) = binSize Then
                    brSH.Range("D" & b) = brSH.Range("D" & b) + bcSH.Range("E" & i)
                    binLockCell = Application.WorksheetFunction.CountIfs(bcSH.Range("G" & i), "true")
                    brSH.Range("F" & b) = binLockCell + brSH.Range("F" & b)
            bExists = True
            Exit For
        Next b
        ' or add new line
        If Not bExists Then
            .Range("b" & b + 1).Value = bcSH.Range("B" & i).Value
            .Range("c" & b + 1).Value = bcSH.Range("c" & i).Value
            .Range("D" & b + 1).Value = bcSH.Range("E" & i).Value
            binLockCell = Application.WorksheetFunction.CountIfs(bcSH.Range("G" & i), "true")
            .Range("F" & b + 1) = binLockCell + .Range("F" & b + 1)
        End If
        
    End If
user_127045930
Related