Subtract values in column VBA

[ib25]

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]

Please post a sample workbook.

[ib25]

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]

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]

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]

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


Capture.JPG

Maybe you should take your sample workbook and shade the cells in R for rows to be deleted

[ib25]

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


Capture.JPG

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]

If all the rows are deleted, this is an acceptable outcome as it means there is no error ��

[Paul_Hossler]

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]

Exactly Paul, that's whar I've been trying to work out, deleting in pairs.

[snb]

Don't remove rows/columns one by one.

[Paul_Hossler]

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]

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]

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

[snb]

see:

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

[ib25]

hey,

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

[snb]

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]

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]

Please do not quote !

[Paul_Hossler]

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