Equation returns 0 when it should not (VBA)

[zack8576]

I have a subroutine that counts the total square foot of a paint (CS-55) in any given excel file, converts it to gallonage, and add a row to the end of the file to display this gallonage number.

below is a screenshot of a test file, the square footage is in column C, and description is in K.
If description contains one letter 'B" (row 11), it calculates the gallonage based on one layer of paint, otherwise it always calculates based on two layers.

the code has been returning the number 0 on a bunch of test files, and I am really not sure why. any help is greatly appreciated as always.
test file link below, full code below as well, thanks !

2022100191 conwrap paint multi color.csv

Shared with Dropbox

www.dropbox.com

Sub PaintCS55Black()
  Dim ws1 As Worksheet
  Dim lrNew As Long, lr As Long, n As Long, n1 As Long, n2 As Long, sr As Long, RCount As Long, desc As String
  Set ws1 = ActiveSheet

   lr = ws1.Range("K" & Rows.Count).End(xlUp).Row
   sr = 2

   If InStr(desc, "CS55") Then
        n = Len(desc) - (Len(Replace(desc, "B", "", 1, , vbBinaryCompare)))
   End If
   RCount = n

   If ws1.Cells(lr, "K").Value Like "*CS55**Black*" Then
         n1 = WorksheetFunction.SumIfs(ws1.Range("C" & sr & ":C" & lr), ws1.Range("K" & sr & ":K" & lr), "*CS55**Black*")
         n2 = n1 * 0.000666 * 7.48 * 2
   End If
   If ws1.Cells(lr, "K").Value Like "*CS55*" And _
      n - 1 = 0 Then
         n1 = WorksheetFunction.SumIfs(ws1.Range("C" & sr & ":C" & lr), ws1.Range("K" & sr & ":K" & lr), "*CS55**Black*")
         n2 = n1 * 0.000666 * 7.48 * 2
   End If
   If ws1.Cells(lr, "K").Value Like "*CS55*" And _
      n - 1 = 1 Then
         n1 = WorksheetFunction.SumIfs(ws1.Range("C" & sr & ":C" & lr), ws1.Range("K" & sr & ":K" & lr), "*CS55**B*")
         n2 = n1 * 0.000666 * 7.48
   End If
   If ws1.Cells(lr, "K").Value Like "*CS55*" And _
      n - 1 = 2 Then
         n1 = WorksheetFunction.SumIfs(ws1.Range("C" & sr & ":C" & lr), ws1.Range("K" & sr & ":K" & lr), "*CS55**B*")
         n2 = n1 * 0.000666 * 7.48 * 2
   End If
   lrNew = lr + 1
   ws1.Cells(lrNew, "A") = ws1.Cells(lr, "A")
   ws1.Cells(lrNew, "B") = "."
   ws1.Cells(lrNew, "C") = n2
   ws1.Cells(lrNew, "D") = "F62655"
   ws1.Cells(lrNew, "I") = "Purchased"
   ws1.Cells(lrNew, "K") = "CS55 Black"
   If ws1.Cells(lrNew, "C").Value Like "*0*" Then
    Rows(lrNew).Delete
   End If
End Sub

 

[Alex Blakenburg]

But you didn't answer my question.
If you want B/B/B to be x3, the code is not doing that - need this confirmed.

If you want to exclude R/G it is not doing that.
If you have just Black it is counting it twice.

 

[Alex Blakenburg]

This outputs the conversion information starting at Column V so you can validate the results.
You can delete or comment out the 3 sections using an array. If you only comment out the 3rd section you can still see the array values in the watch window.
It also uses your original line of code counting the number of Bs in the descrtiption.

' Based on Jeff's Post 14
Sub PaintCS55Black_withValidationArray()

  Dim ws1 As Worksheet
  Dim LastRow As Long, TotalGallons As Double, Desc As String
  Set ws1 = ActiveSheet
  Dim Row As Long
  Dim SqFt As Double, Gallons As Double
  Dim CountBs As Long
  
  Const ConvertToSqFt As Double = 0.000666 * 7.48
  
   LastRow = ws1.Range("K" & Rows.Count).End(xlUp).Row
   
   ' *** This section can be deleted - validation only (1 of 3)
   Dim arr() As Variant
   Dim ColArrOut As String
   ReDim arr(1 To LastRow, 1 To 6) As Variant
   ColArrOut = "V"                      ' <--- Output of validation Columns
   ' *** end of section

   For Row = 2 To LastRow
   
      Desc = ws1.Cells(Row, "K").Value
      If Desc Like "*CS55*" Then
        CountBs = Len(Desc) - (Len(Replace(Desc, "B", "", 1, , vbBinaryCompare)))

         SqFt = CountBs * CDbl(Replace(ws1.Cells(Row, "C"), " SqFt", ""))
         Gallons = ConvertToSqFt * SqFt
         TotalGallons = TotalGallons + Gallons
         
   ' *** This section can be deleted - validation only (2 of 3)
         arr(Row, 1) = Row
         arr(Row, 2) = Desc
         arr(Row, 3) = SqFt
         arr(Row, 4) = CountBs
         arr(Row, 5) = Gallons
         arr(Row, 6) = TotalGallons
        ' *** end of section
      End If
      
   Next Row
         
   
   If TotalGallons = 0 Then
      MsgBox "No matches found."
   Else
   
      LastRow = LastRow + 1
      With ws1
         Cells(LastRow, "A") = Cells(LastRow, "A")
         Cells(LastRow, "B") = "."
         Cells(LastRow, "C") = TotalGallons
         Cells(LastRow, "D") = "F62655"
         Cells(LastRow, "I") = "Purchased"
         Cells(LastRow, "K") = "CS55 Black"
      End With
   End If
   
   ' *** This section can be deleted - validation only (3 of 3)
   Range(ColArrOut & "1").Resize(UBound(arr), UBound(arr, 2)) = arr
   Range(ColArrOut & "1").Resize(, UBound(arr, 2)) = Array("Row No", "Desc", "Sq Ft", "Cnt Bs", "Gallons", "Total Gallons")
   ' *** end of section
   
End Sub

 

[zack8576]

But you didn't answer my question.
If you want B/B/B to be x3, the code is not doing that - need this confirmed.

Yes, if it is B/B/B, it needs to 3x

 

[zack8576]

If you want to exclude R/G it is not doing that.
If you have just Black it is counting it twice.

If it is R/G, or R/R, or R/R/R, or G/R...etc, anything without letter B or Black, it will need to be 0

 

[Alex Blakenburg]

Thanks I have assumed that in the code I posted on #22. Try it and let me know how go.

 

[zack8576]

Thanks I have assumed that in the code I posted on #22. Try it and let me know how go.

I've tested it on 3 files, so far the outcomes are correct.
There is one thing I dont really understand though, I noticed you and Jeff like to use this to add a new row:

LastRow = LastRow + 1

However, this always resulted in column A in the new row does not copy the value from cell above

In Jeff's code I changed this to

lrNew = LastRow + 1

and it was copying the value from the cell above just fine

But when I did the same thing to your code, instead of adding a new row, now the data that was supposed to go on the new row are on row 10, which is the last row on the original file.
Any pointer would be greatly appreciated

 

[zack8576]

If TotalGallons = 0 Then
MsgBox "No matches found."
Else

LastRow = LastRow + 1
With ws1
Cells(LastRow, "A") = Cells(LastRow, "A")
Cells(LastRow, "B") = "."
Cells(LastRow, "C") = TotalGallons
Cells(LastRow, "D") = "F62655"
Cells(LastRow, "I") = "Purchased"
Cells(LastRow, "K") = "CS55 Black"
End With
End If

Alex I really like the way you handled this part of the code, if value is zero then no row added
I used to always add a row first, if value in C is 0 then remove the row

I will use your method on some of the future codes

 

[Alex Blakenburg]

Jeff gets the credit for that one. It's in his original code.

 

[zack8576]

Jeff gets the credit for that one. It's in his original code.

You are right, Jeff did write that originally. It is very late and I must be sleepy Lol...

 

[zack8576]

Jeff gets the credit for that one. It's in his original code.

If TotalGallons = 0 Then
      MsgBox "No matches found."
   Else
      lrNew = LastRow + 1
      With ws1
         Cells(lrNew, "A") = Cells(LastRow, "A")
         Cells(lrNew, "B") = "."
         Cells(lrNew, "C") = TotalGallons
         Cells(lrNew, "D") = "F62655"
         Cells(lrNew, "I") = "Purchased"
         Cells(lrNew, "K") = "CS55 Black"
      End With
   End If

I've added a lrNew to the code, and slightly modified this part
now it is copying the value in column A, and it seems everything else is working the way it's supposed to be