Equation returns 0 when it should not (VBA)

zack8576

Active Member
Joined
Dec 27, 2021
Messages
271
Office Version
  1. 365
Platform
  1. Windows
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.
1673142346322.png


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 !


VBA Code:
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
 
One way, using SUMPRODUCT function with range once, no loop:
VBA Code:
Option Explicit
Sub PaintCS55Black()
Dim lr&, SQ As String, CS As String, Gal As Double
lr = Cells(Rows.Count, "A").End(xlUp).Row
SQ = Range("C2:C" & lr).Address: CS = Range("K2:K" & lr).Address
Gal = Evaluate("=SUMPRODUCT(SUBSTITUTE(" & SQ & ",""SqFt"","""")*ISNUMBER(SEARCH(""CS55""," & CS & "))*(LEN(" & CS & ")-LEN(SUBSTITUTE(" & CS & ",""B"",""""))))*0.000666*7.48")
Range(Cells(lr + 1, "A"), Cells(lr + 1, "K")).Value = Array(Cells(lr, "A").Value, ".", Gal, "F62655", , , , , "Purchase", , "CS55 Black")
End Sub
 
Upvote 0

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
One way, using SUMPRODUCT function with range once, no loop:
VBA Code:
Option Explicit
Sub PaintCS55Black()
Dim lr&, SQ As String, CS As String, Gal As Double
lr = Cells(Rows.Count, "A").End(xlUp).Row
SQ = Range("C2:C" & lr).Address: CS = Range("K2:K" & lr).Address
Gal = Evaluate("=SUMPRODUCT(SUBSTITUTE(" & SQ & ",""SqFt"","""")*ISNUMBER(SEARCH(""CS55""," & CS & "))*(LEN(" & CS & ")-LEN(SUBSTITUTE(" & CS & ",""B"",""""))))*0.000666*7.48")
Range(Cells(lr + 1, "A"), Cells(lr + 1, "K")).Value = Array(Cells(lr, "A").Value, ".", Gal, "F62655", , , , , "Purchase", , "CS55 Black")
End Sub
Thanks Bebo! I will try this out as well
 
Upvote 0
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.

VBA Code:
' 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
Hey Alex
CS55,Black should result in 2x, it is only 1x right now
and I have another question, is there a way to have the result to be an integer ?

thanks !
 
Upvote 0
Just update: Black * 2 and Integer outcome

VBA Code:
Option Explicit
Sub PaintCS55Black()
Dim lr&, SQ As String, CS As String, Gal As Double
lr = Cells(Rows.Count, "A").End(xlUp).Row
SQ = Range("C2:C" & lr).Address: CS = Range("K2:K" & lr).Address
Gal = Evaluate("=INT(SUMPRODUCT(SUBSTITUTE(" & SQ & ",""SqFt"","""")*ISNUMBER(SEARCH(""CS55""," & CS & "))*(LEN(SUBSTITUTE(" & CS & ", ""Black"", ""B/B""))-LEN(SUBSTITUTE(SUBSTITUTE(" & CS & ", ""Black"", ""B/B""),""B"",""""))))*0.000666*7.48)")
Range(Cells(lr + 1, "A"), Cells(lr + 1, "K")).Value = Array(Cells(lr, "A").Value, ".", Gal, "F62655", , , , , "Purchase", , "CS55 Black")
End Sub
 
Upvote 0
Hey Alex
CS55,Black should result in 2x, it is only 1x right now
and I have another question, is there a way to have the result to be an integer ?
Not sure what the logic is for making Black time 2 but just replace this:
VBA Code:
CountBs = Len(Desc) - (Len(Replace(Desc, "B", "", 1, , vbBinaryCompare)))

With this:
VBA Code:
        If Desc Like "*Black*" Then
            CountBs = 2
        Else
            CountBs = Len(Desc) - (Len(Replace(Desc, "B", "", 1, , vbBinaryCompare)))
        End If

At what point do you want it converted to an integer. If it is only the final total then just add it to the output line as per the below:
VBA Code:
Cells(LastRow, "C") = Int(TotalGallons)
 
Upvote 0
Just update: Black * 2 and Integer outcome

VBA Code:
Option Explicit
Sub PaintCS55Black()
Dim lr&, SQ As String, CS As String, Gal As Double
lr = Cells(Rows.Count, "A").End(xlUp).Row
SQ = Range("C2:C" & lr).Address: CS = Range("K2:K" & lr).Address
Gal = Evaluate("=INT(SUMPRODUCT(SUBSTITUTE(" & SQ & ",""SqFt"","""")*ISNUMBER(SEARCH(""CS55""," & CS & "))*(LEN(SUBSTITUTE(" & CS & ", ""Black"", ""B/B""))-LEN(SUBSTITUTE(SUBSTITUTE(" & CS & ", ""Black"", ""B/B""),""B"",""""))))*0.000666*7.48)")
Range(Cells(lr + 1, "A"), Cells(lr + 1, "K")).Value = Array(Cells(lr, "A").Value, ".", Gal, "F62655", , , , , "Purchase", , "CS55 Black")
End Sub
Thanks Bebo !
 
Upvote 0
Not sure what the logic is for making Black time 2 but just replace this:
VBA Code:
CountBs = Len(Desc) - (Len(Replace(Desc, "B", "", 1, , vbBinaryCompare)))

With this:
VBA Code:
        If Desc Like "*Black*" Then
            CountBs = 2
        Else
            CountBs = Len(Desc) - (Len(Replace(Desc, "B", "", 1, , vbBinaryCompare)))
        End If

At what point do you want it converted to an integer. If it is only the final total then just add it to the output line as per the below:
VBA Code:
Cells(LastRow, "C") = Int(TotalGallons)
Alex, thank you, these are the 2 answers I am looking for.

Not trying to bore you to death, so I will keep it short

We have an outdated system, that goes like this:
software 1 spits out a csv file ----- VBA codes to process it ----- then this processed csv files gets imported into a database

in software 1 database, the description of 1 layer of black paint, is CS55 Black, and we have been using this same format for decades
Sure I can modify it to CS55 B in the database so it will show CS55 B in the csv , but this would cause mass confusion amoung the many dozens of users of software 1. (Sounds silly, but it is true)

Hopefully that explains the reasoning for using CS55 Black and not CS55 B
 
Upvote 0
Not sure what the logic is for making Black time 2 but just replace this:
VBA Code:
CountBs = Len(Desc) - (Len(Replace(Desc, "B", "", 1, , vbBinaryCompare)))

With this:
VBA Code:
        If Desc Like "*Black*" Then
            CountBs = 2
        Else
            CountBs = Len(Desc) - (Len(Replace(Desc, "B", "", 1, , vbBinaryCompare)))
        End If

At what point do you want it converted to an integer. If it is only the final total then just add it to the output line as per the below:
VBA Code:
Cells(LastRow, "C") = Int(TotalGallons)
correction: in software 1 database, the description of 2 layer of just black paint, is CS55 Black
 
Upvote 0
Alex, thank you, these are the 2 answers I am looking for.

Not trying to bore you to death, so I will keep it short

We have an outdated system, that goes like this:
software 1 spits out a csv file ----- VBA codes to process it ----- then this processed csv files gets imported into a database

in software 1 database, the description of 1 layer of black paint, is CS55 Black, and we have been using this same format for decades
Sure I can modify it to CS55 B in the database so it will show CS55 B in the csv , but this would cause mass confusion amoung the many dozens of users of software 1. (Sounds silly, but it is true)

Hopefully that explains the reasoning for using CS55 Black and not CS55 B
I am about to log off but my issue wasn't whether you called it Black or B. It was that if you just called it B the logic said it was to be x 1, but when you call it Black you have specified it should be x 2.
 
Upvote 0
ok we crossed over in the ether, you can ignore my previous post it was before you added the correction. All good. Goodnight from Australia
 
Upvote 0

Forum statistics

Threads
1,214,583
Messages
6,120,383
Members
448,955
Latest member
BatCoder

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