Remove the value in column D

Z

zack8576

Active Member
Joined
Dec 27, 2021
Messages
271
Office Version
  1. 365
Platform
  1. Windows
I have this code that counts the qty of a certain item, adds a row at the end of the excel file to show the qty
If the total qty adds up to 0, the code removes this new row, what if I just want to remove the value in column D in the new row instead of removing the entire row when the value is 0?

VBA Code: 
Public lr2 As Long
Public c As Range
Public lr As Long
Sub EyeboltsAndChains()
    'Sum up the # of eyebolt & chains
    lr2 = lr + 1                    ' set lr2 to one row below the current lr row
    Set c = ws1.Range("C" & lr2)    ' use this cell as our starting point
    With c
        .Offset(, -2).Value = .Offset(-1, -2).Value 'ADD ADDITIONAL ROW
        .FormulaR1C1 = "=COUNTIF(R2C11:R" & lr & "C11,""CHAIN & EYEBOLT"")" 'COUNT THE TOTAL NUMBER OF EYEBOLT & CHAINS, SHOW THEM ON THE NEW ROW
        .Value = .Value
        .Offset(, -1).Value = "!"
        .Offset(, 1).Value = "F09720"
        .Offset(, 6).Value = "Purchased"
        .Offset(, 8).Value = "CHAIN & EYEBOLT"
        .EntireRow.Font.Bold = True
    End With
   If ws1.Range("C" & i3).Value Like "*0*" Then
           ws1.Rows(lr2).Delete
       End If
End Sub
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Sort by date Sort by votes
Hi. Try the below.

VBA Code: 
Public lr2 As Long
Public c As Range
Public lr As Long
Sub EyeboltsAndChains()
    'Sum up the # of eyebolt & chains
    lr2 = lr + 1                    ' set lr2 to one row below the current lr row
    Set c = ws1.Range("C" & lr2)    ' use this cell as our starting point
    With c
        .Offset(, -2).Value = .Offset(-1, -2).Value 'ADD ADDITIONAL ROW
        .FormulaR1C1 = "=COUNTIF(R2C11:R" & lr & "C11,""CHAIN & EYEBOLT"")" 'COUNT THE TOTAL NUMBER OF EYEBOLT & CHAINS, SHOW THEM ON THE NEW ROW
        .Value = .Value
        .Offset(, -1).Value = "!"
        .Offset(, 1).Value = "F09720"
        .Offset(, 6).Value = "Purchased"
        .Offset(, 8).Value = "CHAIN & EYEBOLT"
        .EntireRow.Font.Bold = True
    End With
   If ws1.Range("C" & i3).Value Like "*0*" Then
           'Goes to lr2's row and column D to clear the contents
           ws1.cells(lr2,4).ClearContents
   End If
End Sub
 
Upvote 0
Solution
breynolds0431 said:
Hi. Try the below.

VBA Code: 
Public lr2 As Long
Public c As Range
Public lr As Long
Sub EyeboltsAndChains()
    'Sum up the # of eyebolt & chains
    lr2 = lr + 1                    ' set lr2 to one row below the current lr row
    Set c = ws1.Range("C" & lr2)    ' use this cell as our starting point
    With c
        .Offset(, -2).Value = .Offset(-1, -2).Value 'ADD ADDITIONAL ROW
        .FormulaR1C1 = "=COUNTIF(R2C11:R" & lr & "C11,""CHAIN & EYEBOLT"")" 'COUNT THE TOTAL NUMBER OF EYEBOLT & CHAINS, SHOW THEM ON THE NEW ROW
        .Value = .Value
        .Offset(, -1).Value = "!"
        .Offset(, 1).Value = "F09720"
        .Offset(, 6).Value = "Purchased"
        .Offset(, 8).Value = "CHAIN & EYEBOLT"
        .EntireRow.Font.Bold = True
    End With
   If ws1.Range("C" & i3).Value Like "*0*" Then
           'Goes to lr2's row and column D to clear the contents
           ws1.cells(lr2,4).ClearContents
   End If
End Sub
Click to expand...
thank you
I ran a test with a file that contains 0 chain & eyebolt, error message "Application defined or object defined error"
and it shows the error is coming from that last line.... any idea?
VBA Code: 
ws1.Rows(lr2, 4).Delete
 
Upvote 0
zack8576 said:
thank you
I ran a test with a file that contains 0 chain & eyebolt, error message "Application defined or object defined error"
and it shows the error is coming from that last line.... any idea?
VBA Code: 
ws1.Rows(lr2, 4).Delete
Click to expand...
Looks like that part wasn't updated to the code I provided. It needs to be .cells and use .clearcontents.
 
Upvote 0
breynolds0431 said:
Looks like that part wasn't updated to the code I provided. It needs to be .cells and use .clearcontents.
Click to expand...
Duh, my bad, that is fixed now. One more thing
I tested this with a file that contains chain & eyebolt, here is the result, all the values are in the correct cells
1666298964405.png



when I tested one without chain & eyebolt, Purchased and chain & eyebolt got shifted to the left by 1 cell, any idea why?
1666298998509.png
 

Attachments

  • 1666298914205.png
    1666298914205.png
    11.1 KB · Views: 3
Upvote 0
try trhis,

VBA Code: 
Sub Add_Rainguards()

sr = 2 'Starting Row
lr = Cells(Rows.Count, "A").End(xlUp).Row ' Last Row
n = WorksheetFunction.SumIfs(Range("C" & sr & ":C" & lr), Range("K" & sr & ":K" & lr), "*Rainguards*")
MsgBox n
wr = lr + 1 'this is the new row at the bottom that we are going to write the data to.

Cells(wr, "A") = Cells(lr, "A")
Cells(wr, "C") = n 'number of Rainguards
Cells(wr, "I") = "Purchased"
Cells(wr, "K") = "Rainguards"


''''part 2
Set TargetCell = Range("K" & sr & ":K" & lr).Find(What:="Rainguards", _
    LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False)
rr = TargetCell.Row

Data = ""
x = Cells(rr, "K")
y = Cells(rr, "N")

If x Like "*170**580*" Then Data = "F89998"
If x Like "*170**580*" And y Like "*Hernando*" Then Data = "F89998U"
If x Like "*225**440*" Then Data = "F89999"
If x Like "*667*" Then Data = "F90003"

Cells(wr, "D") = Data

End Sub
 
Upvote 0
rpaulson said:
try trhis,

VBA Code: 
Sub Add_Rainguards()

sr = 2 'Starting Row
lr = Cells(Rows.Count, "A").End(xlUp).Row ' Last Row
n = WorksheetFunction.SumIfs(Range("C" & sr & ":C" & lr), Range("K" & sr & ":K" & lr), "*Rainguards*")
MsgBox n
wr = lr + 1 'this is the new row at the bottom that we are going to write the data to.

Cells(wr, "A") = Cells(lr, "A")
Cells(wr, "C") = n 'number of Rainguards
Cells(wr, "I") = "Purchased"
Cells(wr, "K") = "Rainguards"


''''part 2
Set TargetCell = Range("K" & sr & ":K" & lr).Find(What:="Rainguards", _
    LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False)
rr = TargetCell.Row

Data = ""
x = Cells(rr, "K")
y = Cells(rr, "N")

If x Like "*170**580*" Then Data = "F89998"
If x Like "*170**580*" And y Like "*Hernando*" Then Data = "F89998U"
If x Like "*225**440*" Then Data = "F89999"
If x Like "*667*" Then Data = "F90003"

Cells(wr, "D") = Data

End Sub
Click to expand...
rpaulson said:
try trhis,

VBA Code: 
Sub Add_Rainguards()

sr = 2 'Starting Row
lr = Cells(Rows.Count, "A").End(xlUp).Row ' Last Row
n = WorksheetFunction.SumIfs(Range("C" & sr & ":C" & lr), Range("K" & sr & ":K" & lr), "*Rainguards*")
MsgBox n
wr = lr + 1 'this is the new row at the bottom that we are going to write the data to.

Cells(wr, "A") = Cells(lr, "A")
Cells(wr, "C") = n 'number of Rainguards
Cells(wr, "I") = "Purchased"
Cells(wr, "K") = "Rainguards"


''''part 2
Set TargetCell = Range("K" & sr & ":K" & lr).Find(What:="Rainguards", _
    LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False)
rr = TargetCell.Row

Data = ""
x = Cells(rr, "K")
y = Cells(rr, "N")

If x Like "*170**580*" Then Data = "F89998"
If x Like "*170**580*" And y Like "*Hernando*" Then Data = "F89998U"
If x Like "*225**440*" Then Data = "F89999"
If x Like "*667*" Then Data = "F90003"

Cells(wr, "D") = Data

End Sub
Click to expand...
Thank you for the reply

I ran a test run on this, the message "Type mismatch" popped up
it was coming from
VBA Code: 
Data = ""

I defined the variables at the beginning of the macro, as public variables

VBA Code: 
Public sr As Long, wr As Long,  n As Long, lr As Long, rr As Long, Data As Integer, TargetCell As Range
 
Upvote 0
breynolds0431 said:
Looks like that part wasn't updated to the code I provided. It needs to be .cells and use .clearcontents.
Click to expand...
I just figured out the issue, deleting value in D caused values in I and K shifted 1 cell to the left
so instead of deleting the value in D, I changed the code to change the value in D to a random symbol, which is an acceptable result.
working code below just in case if someone else can use it

VBA Code: 
Sub EyeboltsAndChains()
    sr = 2 'Starting Row
    n = WorksheetFunction.SumIfs(Range("C" & sr & ":C" & lr), Range("K" & sr & ":K" & lr), "*CHAIN & EYEBOLT*")
    lr2 = lr + 1 'this is the new row at the bottom that we are going to write the data to.

    Cells(lr2, "A") = Cells(lr, "A")
    Cells(lr2, "B") = "."
    Cells(lr2, "C") = n 'number of Rainguards
    Cells(lr2, "D") = "F09720"
    Cells(lr2, "I") = "Purchased"
    Cells(lr2, "K") = "CHAIN & EYEBOLT"

    If Cells(lr2, "C").Value Like "*0*" Then
     Cells(lr2, 4) = "."
    End If
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

Z
  • Question Question
Remove a specific row when the value in a certain column is 0
Replies
1
Views
399
zack8576
Z
Z
  • Question Question
Add few variables to a working subroutine VBA
Replies
0
Views
350
zack8576
Z
Z
  • Solved
VBA not copying cell value when running it on certain files
Replies
2
Views
484
zack8576
Z
I
  • Solved
VBA to remove formulas with values causing wrong calculations
2
Replies
12
Views
867
Peter_SSs
Peter_SSs
Z
  • Solved
Add up the qty then add a row to the end to show the qty
2 3
Replies
22
Views
1K
zack8576
Z

Forum statistics

Threads
1,223,886
Messages
6,175,198
Members
452,617
Latest member
Narendra Babu D

Share this page

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