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

Question

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
Bin Conversions
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

Answer 1

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