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

I have written a program that counts bins that are empty(verified), may be empty(unverified), and if they are accessible or not (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 that are locked and will be counted on my Bin Report sheet.

My problem is that on my Bin Reports sheet, they seem to count 1 too many for each group for some reason (which all groups together totals 23 instead of 20). A group example would be 4-Pallet, 2.5ft, 2 bins locked (instead of 1).

Any idea what may be causing this in my code? Am I accidentally adding a 1 somewhere in my code that I shouldn't be?

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

CodePudding user response：

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