View Full Version : Subtract values in column VBA
Hi guys,
So I am trying to create code where it should subtract the current cell value from the next cell value in the column. Should the value be 0, the two columns are deleted. this is the code so far:
Dim ws As Worksheet
Dim rCheck As Range
Dim rDel As Range
Set ws = ActiveWorkbook.ActiveSheet
For Each rCheck In ws.Range("R5", ws.Cells(ws.Rows.Count, "R").End(xlUp)).Cells
If WorksheetFunction.ImSub(ws.Columns("R"), rCheck.Value) = 0 Then
If Not rDel Is Nothing Then
Set rDel = Union(rDel, rCheck)
Else
Set rDel = rCheck
End If
End If
Next rCheck
If Not rDel Is Nothing Then rDel.EntireRow.Delete
I am havng an error in the "If WorksheetFunction.ImSub(ws.Columns("R"), rCheck.Value) = 0" and probably the line before.
I anyone can help that woud be great
Please post a sample workbook.
here is a sample.
the idea is that identical even numbers will cancel out leaving the rows without a pair or unique figures in column R
Paul_Hossler
09-19-2018, 10:38 AM
Hi guys,
So I am trying to create code where it should subtract the current cell value from the next cell value in the column. Should the value be 0, the two columns are deleted. this is the code so far:
Dim ws As Worksheet
Dim rCheck As Range
Dim rDel As Range
Set ws = ActiveWorkbook.ActiveSheet
For Each rCheck In ws.Range("R5", ws.Cells(ws.Rows.Count, "R").End(xlUp)).Cells
If WorksheetFunction.ImSub(ws.Columns("R"), rCheck.Value) = 0 Then
If Not rDel Is Nothing Then
Set rDel = Union(rDel, rCheck)
Else
Set rDel = rCheck
End If
End If
Next rCheck
If Not rDel Is Nothing Then rDel.EntireRow.Delete
I am havng an error in the "If WorksheetFunction.ImSub(ws.Columns("R"), rCheck.Value) = 0" and probably the line before.
I anyone can help that woud be great
I asssume you meant "the ROWS" are deleted
Why are you using ImSub which is a worksheet function for subtracting complex numbers?
I'm pretty new to using VBA so I was looking for something that might work. I understand the function is for more complex figures but I didn't think a simple subtraction might work. could it work? And if so do you have an idea of how the code might look like?
Paul_Hossler
09-19-2018, 12:47 PM
So I am trying to create code where it should subtract the current cell value from the next cell value in the column. Should the value be 0, the two columns are deleted. this is the code so far:
That sounds like if R5 = R6 then delete rows 5 and 6, since R6 - R5 =0 if R5=R6
Since your sample data always seems to come in pairs, I'd think that every row would be deleted
Admittedly I didn't spend a lot of time looking at your macro, only going by the description
22902
Maybe you should take your sample workbook and shade the cells in R for rows to be deleted
That sounds like if R5 = R6 then delete rows 5 and 6, since R6 - R5 =0 if R5=R6
Since your sample data always seems to come in pairs, I'd think that every row would be deleted
Admittedly I didn't spend a lot of time looking at your macro, only going by the description
22902
Maybe you should take your sample workbook and shade the cells in R for rows to be deleted
Hey there,
The bulk of the rows should be deleted leaving those without a matching entry and/or unique values. The sample file is a model of a much larger workbook and the id column of these remaining rows is what is important.
If all the rows are deleted, this is an acceptable outcome as it means there is no error
Paul_Hossler
09-19-2018, 01:37 PM
This is the most common way to delete rows, but I don't think it's what you're looking for
Option Explicit
Sub DeleteRows()
Dim r As Range
Dim i As Long, n As Long
With ActiveSheet
n = .Cells(.Rows.Count, 18).End(xlUp).Row
For i = n To 6 Step -1
If .Cells(i, 18).Value = .Cells(i - 1, 18).Value Then
.Cells(i, 18).Interior.Color = vbRed
' .entirerow(i).delete
End If
Next i
End With
End Sub
It sound like you want to delete by pairs of rows???
Case 1 -- 2 1/2 pairs
1000
1000
1000
1000
1000 <<<<<<<<<< leave this???
2000
2000
2000
2000
Case 2 -- single repeats
1000
1000
1000
1000
2000
2000
2000
2000
1000 <<<<<<< leave this?
3000
3000
Exactly Paul, that's whar I've been trying to work out, deleting in pairs.
Don't remove rows/columns one by one.
Paul_Hossler
09-19-2018, 02:46 PM
Maybe something like this
When deleting rows, you should go bottom to top
I've used a way I'm partial to and marked the rows to be deleted, and deleted them all at once ( although with reasonable amounts of data and a modern comp, it really won't make a perceptible difference I think)
Option Explicit
Sub DeleteRows()
Dim r As Range
Dim i As Long, n As Long
With ActiveSheet
n = .Cells(.Rows.Count, 18).End(xlUp).Row
For i = n To 6 Step -2
If .Cells(i, 18).Value = .Cells(i - 1, 18).Value Then
.Cells(i, 18).Value = True
.Cells(i - 1, 18).Value = True
End If
Next i
On Error Resume Next
.Columns(18).SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete
On Error GoTo 0
End With
End Sub
Use arrays:
Sub M_snb()
sn=sheet1.usedrange.columns(18)
for j=6 to ubound(sn) step 2
if sn(j,1)=sn(j+1,1) then
sn(j,1)=""
sn(j,j+1)=""
end if
next
sheet1.usedrange.columns(18)=sn
sheet1.usedrange.columns(18).offset(5).specialcells(4).entirerow.delete
End Sub
Use arrays:
Sub M_snb()
sn=sheet1.usedrange.columns(18)
for j=6 to ubound(sn) step 2
if sn(j,1)=sn(j+1,1) then
sn(j,1)=""
sn(j,j+1)=""
end if
next
sheet1.usedrange.columns(18)=sn
sheet1.usedrange.columns(18).offset(5).specialcells(4).entirerow.delete
End Sub
Thanks :yes
see:
http://www.snb-vba.eu/VBA_Arrays_en.html
hey,
I keep getting an error "Subscript out of range" in Ln 5 and 7. What could be the problem?
O, Typo
Sub M_snb()
sn=sheet1.usedrange.columns(18)
for j=6 to ubound(sn) step 2
if sn(j,1)=sn(j+1,1) then
sn(j,1)=""
sn(j+1,1)=""
end if
next
sheet1.usedrange.columns(18)=sn
sheet1.usedrange.columns(18).offset(5).specialcells(4).entirerow.delete
End Sub
PS. If you are not able to detect these simple errors I would advise you not to use any VBA at all.
Do not use code you do not fully understand !
O, Typo
Sub M_snb()
sn=sheet1.usedrange.columns(18)
for j=6 to ubound(sn) step 2
if sn(j,1)=sn(j+1,1) then
sn(j,1)=""
sn(j+1,1)=""
end if
next
sheet1.usedrange.columns(18)=sn
sheet1.usedrange.columns(18).offset(5).specialcells(4).entirerow.delete
End Sub
PS. If you are not able to detect these simple errors I would advise you not to use any VBA at all.
Do not use code you do not fully understand !
I did try this but the error goes back to line 5, I tried checking what could be the issue, and finally posted this reply.
Paul_Hossler
09-24-2018, 06:26 AM
I did try this but the error goes back to line 5, I tried checking what could be the issue, and finally posted this reply.
The logic is essentially the same as the more wordy macro in #12
You can use the terse version or the verbose version, but maybe if you followed the logic in post #12 you would see the source of the error
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.