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
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Based on your description I can't tell if this is supposed to be counted. There is no B at all.

Paint,CS55,R/G
 
Upvote 0
Here is the revised code. You will need to do a calculation by hand to make sure this matches your requirements. It wasn't clear if you wanted to count rows for CS55 that have no B in the code.
VBA Code:
Option Explicit

Sub PaintCS55Black()

  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
  Const ConvertToSqFt As Double = 0.000666 * 7.48
  
  
   LastRow = ws1.Range("K" & Rows.Count).End(xlUp).Row

   For Row = 2 To LastRow
   
      Desc = ws1.Cells(Row, "K").Value
      If Desc Like "*CS55*" Then
      
         SqFt = ConvertToSqFt * CDbl(Replace(ws1.Cells(Row, "C"), " SqFt", ""))
         
         TotalGallons = TotalGallons + SqFt
         
         If Desc Like "*B*B*" Or Desc Like "*Black*" Then
            TotalGallons = TotalGallons + SqFt
         End If
         
      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
   
End Sub
 
Upvote 0
Based on your description I can't tell if this is supposed to be counted. There is no B at all.

Paint,CS55,R/G
There are files that will have description like CS-55, R/G, or something similar, without the letter B
for these files, n2 should return as 0, and then the row will be deleted
 
Upvote 0
Here is the revised code. You will need to do a calculation by hand to make sure this matches your requirements. It wasn't clear if you wanted to count rows for CS55 that have no B in the code.
VBA Code:
Option Explicit

Sub PaintCS55Black()

  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
  Const ConvertToSqFt As Double = 0.000666 * 7.48
 
 
   LastRow = ws1.Range("K" & Rows.Count).End(xlUp).Row

   For Row = 2 To LastRow
  
      Desc = ws1.Cells(Row, "K").Value
      If Desc Like "*CS55*" Then
     
         SqFt = ConvertToSqFt * CDbl(Replace(ws1.Cells(Row, "C"), " SqFt", ""))
        
         TotalGallons = TotalGallons + SqFt
        
         If Desc Like "*B*B*" Or Desc Like "*Black*" Then
            TotalGallons = TotalGallons + SqFt
         End If
        
      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
  
End Sub
thanks Jeff

I will run it a few times on separate files, and do some hand calc to see if the numbers match
I will let you know shortly thanks !!
 
Upvote 0
Here is the revised code. You will need to do a calculation by hand to make sure this matches your requirements. It wasn't clear if you wanted to count rows for CS55 that have no B in the code.
VBA Code:
Option Explicit

Sub PaintCS55Black()

  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
  Const ConvertToSqFt As Double = 0.000666 * 7.48
 
 
   LastRow = ws1.Range("K" & Rows.Count).End(xlUp).Row

   For Row = 2 To LastRow
  
      Desc = ws1.Cells(Row, "K").Value
      If Desc Like "*CS55*" Then
     
         SqFt = ConvertToSqFt * CDbl(Replace(ws1.Cells(Row, "C"), " SqFt", ""))
        
         TotalGallons = TotalGallons + SqFt
        
         If Desc Like "*B*B*" Or Desc Like "*Black*" Then
            TotalGallons = TotalGallons + SqFt
         End If
        
      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
  
End Sub
here are the results, some numbers are slightly different due to rounding

Test file 1:
hand calc: 9.77 gallon, VBA: 9.78
1673287158411.png


Test file 2:
hand calc: 26.23, VBA: 26.23
1673288005892.png


Test file 3, no B or Black:
hand calc: 0, VBA: 26.23
1673288186919.png


Any file that does not contain B or Black are not calculated correctly
 
Upvote 0
Here is the revised code. You will need to do a calculation by hand to make sure this matches your requirements. It wasn't clear if you wanted to count rows for CS55 that have no B in the code.
VBA Code:
Option Explicit

Sub PaintCS55Black()

  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
  Const ConvertToSqFt As Double = 0.000666 * 7.48
 
 
   LastRow = ws1.Range("K" & Rows.Count).End(xlUp).Row

   For Row = 2 To LastRow
  
      Desc = ws1.Cells(Row, "K").Value
      If Desc Like "*CS55*" Then
     
         SqFt = ConvertToSqFt * CDbl(Replace(ws1.Cells(Row, "C"), " SqFt", ""))
        
         TotalGallons = TotalGallons + SqFt
        
         If Desc Like "*B*B*" Or Desc Like "*Black*" Then
            TotalGallons = TotalGallons + SqFt
         End If
        
      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
  
End Sub
I tried to add a statement like
VBA Code:
If Desc Like "*CS55*" And _
   Not Desc Like "*Black*" Or _
   Not Desc Like "*B*" Then
         SqFt = ConvertToSqFt * CDbl(Replace(ws1.Cells(Row, "C"), " SqFt", ""))
         TotalGallons = 0

this did fix the issue on any file without B or Black, but the TotalGallons on files with letter B or Black are spitting out the number 0 now :(
 
Upvote 0
Hi Zack, I think at some point you need to address your end to end process. I suspect that Power Query would be a better fit for what you are trying to do.
What do you want to happen when you have Paint,CS55,B/B/B ? do you want 3x ?
How do you actually know that the B's are all Black and none of them are Blue ?

 
Upvote 0
Hi Zack, I think at some point you need to address your end to end process. I suspect that Power Query would be a better fit for what you are trying to do.
What do you want to happen when you have Paint,CS55,B/B/B ? do you want 3x ?
How do you actually know that the B's are all Black and none of them are Blue ?
Thanks Alex. I did explain the process near the top of this post, I've posted it below
but I did fail to mention special cases like B/B/B
if there are 3 B, indeed I will need to 3x, if it is Paint,CS55,R/G, it will be 0.
luckily for me, there are 3 possible colors, Black(B), Gray(G), and Red(R), so B will always be Black

I have many excel files that contain this paint (CS-55 Black), and many other files that do not.
For the files that do contain this material, I want to calculate the total gallonage of the paint (n2) and display this number in column C on the new row after the last row;
for the files that do not contain this material, n2 will be 0 and the new row will be removed.

the description in column K can be any of these: CS-55 B/G/R, CS-55 B/B/R, CS-55 Black, CS-55 B/G, CS-55 R/G/B...etc
If there are 2 letter B in the description, or if Black is in description, it will get 2 layers.
otherwise, it gets 1 layer.

the qty of the material in these excel files are sq ft, they are always in column C. They typically exist on multiple rows, n1 is the total sq ft for all the rows that contain this paint.
Then I am using the equation n2 = n1 * 0.000666 * 7.48 to convert n1 to gallon. If there are 2 layers of the paint then the equation becomes n2 = n1 * 0.000666 * 7.48 * 2
the value of n2 will then be displayed in column C on row lrNew

for the example below, n1 = 213.87 sqft, and description contains 1 letter B, so it is 1 layer.
So we have: n2 = 213.87 * 0.000666 * 7.48 = 1.06 ( I would prefer to always round up n2 to the next integer , so n2 in this case should be 2)
1673199446357-png.82309

Jeff's code works almost perfectly, it only fails when there is no letter B or Black after Paint,CS55

And as a lowly amateur, I've been trying to fix this code and have been failing
 
Upvote 0

Forum statistics

Threads
1,223,230
Messages
6,170,883
Members
452,364
Latest member
springate

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