Basic Macro Code Help 2

[ease20022002]

Hi Nimrod, or whomever, I am trying to do the following: Basically there are only 2 columns that are important. In the first column there will be MCP codes. All the codes will not be identical and before proceeding to the next calculation, I wan't to make sure that the MCP code in the activecell is equal to the cell below it (or whatever matrix calculation is used). If it is equal, then I want to see if the sum of two corresponding QUANTITY amounts to the MCP codes = 0. So basically I am comparing one row to the row below it. If the MCP codes are = then I want to see if the corresponding QUANTITies = 0, then I will delete the two rows. I am only comparing two rows at a time. After deleteing the two rows, I move back up 1 record and begin the process again, if the MCP codes do not match, then I move to the next row and begin again.

I have solved the problem using a DO WHILE loop, but I know there is a more efficient way to write this code and I am trying to learn. Below is a more complete list of the data. This is really all you need to see of the data, there isn't anything else that is important.

MCP             QUANTITY
15LB/665760/3100	-1
15LB/665760/3100	-1
15LB/665760/3100	-1
15LB/665760/3100	-1
15LB/665760/3100	-1
15LB/665760/3100	-1
15LB/665760/3100	1
15LB/665760/3100	1
15LB/665760/3100	1
15LB/665760/3100	1
15LB/665760/3100	1
15LB/665760/3100	1
20EY/137155/3500	-1
20EY/26014/3100	1
20EY/543732/3000	-1
20EY/543732/3000	1
20EY/543732/3000	1
20EY/550158/3400	-1
20GB/26014/3000	1
20GB/543732/3000	-1
20GB/543732/3000	1
20GB/543732/3000	1

Now I will post the code that I am trying to do and the code that I have that works:

Code that doesn't work:

Sub MB51DupDeletion2()
Range("a1").Activate
'   this macro is used after the data has been sorted in
'   ascending order for the MCP, Quantity and Doc Date fields.
Dim TotalRange As Range, Mcp As Range, Quantity As Range, DupRow As Range

Set TotalRange = Range("a2", Range("a65536").End(xlUp))

'   the following loop assures that before performing any
'   deletions, the MCP numbers are identical.  If the MCP
'   codes are identical, the loop then determines if the
'   sum of the Quantity of the two records equals 0.  If
'   they do = 0 (TRUE) then the two records are deleted and
'   the previous row is selected to run through again.  If
'   any test is FALSE, then the next record is selected and
'   loop begins again.

For Each Mcp In TotalRange
Set Quantity = Mcp(0, 1)
If Mcp = Mcp(1, 0) Then
   If Quantity + Quantity(1, 0) = 0 Then
       Set DupRow = Mcp.EntireRow
       Mcp.EntireRow.Delete
       Set Mcp = Mcp(-1, 0)
   ElseIf Quantity + Quantity(1, 0) <> 0 Then
       Set Mcp = Mcp(1, 0)
   End If
ElseIf Mcp <> Mcp(1, 0) Then
   Set Mcp = Mcp(1, 0)
End If
Next

And here is the code that works:

Sub MB51DupDeletion()
Range("a1").Activate
'   this macro is used after the data has been sorted in
'   ascending order for the MCP, Quantity and Doc Date fields.

Dim Mcp As Range
Dim Mcp2 As Range
Dim Quantity As Range
Dim Quantity2 As Range

'   the following loop assures that before performing any
'   deletions, the MCP numbers are identical.  If the MCP
'   codes are identical, the loop then determines if the
'   sum of the Quantity of the two records equals 0.  If
'   they do = 0 (TRUE) then the two records are delete and
'   the previous row is selected to run through again.  If
'   any test is FALSE, then the next record is selected and
'   loop begins again.

Do While ActiveCell <> ""
Set Mcp = ActiveCell
Set Mcp2 = ActiveCell.Offset(1, 0)
Set Quantity = ActiveCell.Offset(0, 1)
Set Quantity2 = ActiveCell.Offset(1, 1)
If Mcp.Value = Mcp2.Value Then
   If Quantity.Value + Quantity2.Value = 0 Then
       ActiveCell.Rows.EntireRow.Delete
       ActiveCell.Rows.EntireRow.Delete
       ActiveCell.Offset(-1, 0).Activate
   ElseIf Quantity.Value + Quantity2.Value <> 0 Then
       ActiveCell.Offset(1, 0).Activate
   End If
ElseIf Mcp.Value <> Mcp2.Value Then
   ActiveCell.Offset(1, 0).Activate
End If
Loop

 

[Tazguy37]

Instead of deleting entire rows (which AFAIK is quite time consuming):

       ActiveCell.Rows.EntireRow.Delete
       ActiveCell.Rows.EntireRow.Delete

You could use:

    ActiveCell.Resize(2, 5).Delete -4162

Just change the 5 to however many columns you're dealing with. The example above will delete from the active cell down and to the right to include 2 rows, and 5 columns, and shift the remaining rows up.

Hope that helps!