PDA

View Full Version : Subtract values in column VBA



ib25
09-19-2018, 04:40 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

snb
09-19-2018, 05:19 AM
Please post a sample workbook.

ib25
09-19-2018, 05:46 AM
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?

ib25
09-19-2018, 10:59 AM
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

ib25
09-19-2018, 01:02 PM
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.

ib25
09-19-2018, 01:06 PM
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

ib25
09-19-2018, 01:43 PM
Exactly Paul, that's whar I've been trying to work out, deleting in pairs.

snb
09-19-2018, 01:53 PM
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

snb
09-20-2018, 02:35 AM
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

ib25
09-21-2018, 12:25 AM
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

snb
09-21-2018, 01:14 AM
see:

http://www.snb-vba.eu/VBA_Arrays_en.html

ib25
09-24-2018, 01:23 AM
hey,

I keep getting an error "Subscript out of range" in Ln 5 and 7. What could be the problem?

snb
09-24-2018, 01:57 AM
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 !

ib25
09-24-2018, 02:05 AM
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.

snb
09-24-2018, 06:20 AM
Please do not quote !

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