Deleting rows based on two criteria

[ultracyclist]

I have a very large spreadsheet (>10,000 rows) of data. I did Conditional Formatting based on duplicate values for the serial numbers column (B) and then sorted to “Put Selected Cell Color on top”. Next I did a sort by the Last Scan Date column M (Oldest to New). The date/time format appears as follows

I used the following macro to delete rows with duplicate serial numbers but retain the row that has the newest time stamp. When I run my macro it’s doing the opposite where it deletes rows with the newest time stamp and retains the oldest time stamp.

</SPAN>

Sub Test()
'for Macro to Delete Duplicate Rows and Retain Unique Value
Dim LR As Long
LR = ActiveSheet.UsedRange.Rows.Count
Cells.Select
ActiveSheet.Range("$A$1:$M$" & LR).RemoveDuplicates Columns:=2, Header:=xlYes
End Sub

</SPAN></SPAN>

I would like to revise the macro to include the following.

• Delete rows with duplicate serial numbers but retain the row that has the newest time stamp</SPAN>
• Highlight only cells in the range A:M (incl Column Headers) that contain a color palette number of -4142 for cells in column B.</SPAN>
• Do a data sort of the selected cell range based on column L “Last Time Stamp”. Sort by Oldest to Newest.</SPAN>
• Ignore rows that do not contain a serial number value in column B

</SPAN>
Sample data

Machine	SerialNumber	LastScanTime
XXWZ-2233	VMware-42 2a 3e 94	01/12/2013 09:21:00
XXWZ-2233	VMware-42 2a 3e 94	01/12/2013 09:55:00
XXWZ-2233	VMware-42 2a 3e 94	01/12/2013 09:55:00
XXWZ-2233	VMware-42 2a 3e 94	01/12/2013 10:29:00
CSRW-13444	SGH923030J	02/20/2013 14:26:00
CSRW-13444	SGH923030J	02/28/2013 16:15:00
		04/18/2013 16:54:00
		04/18/2013 17:30:00

<TBODY>
</TBODY>

Thanks,

Allen
</SPAN></SPAN>

 

[oldbrewer]

If you first of all sort by column B and delete all rows with blanks, then sort by column C ascending, then check each adjacent pair in col A and if they are the same delete the first (top of pair) one, will this give you what you want?

 

[ultracyclist]

Because the data set is so large its very time consuming to manually check each row. Thus the reason for the macro. The macro is working but in the reverse order so I'm trying to figure out what needs to be corrected to meet my objectives.

I can't delete blank rows which do not contain a serial number in column B. Those are few so I can manually review those, but the other requirements, I would like to automate through a macro.

 

[JoeMo]

This is untested so try it on a copy of your data. Assumes the header row starts in A1.

Sub RemoveDupRowsConditionally()
Dim lR As Long, R As Range, vA As Variant, dRws As Range
Set R = Range("B1").CurrentRegion
'Sort by Serial Number
R.Sort key1:=[B2], Order1:=xlAscending, Header:=xlYes
vA = R.Value
For i = LBound(vA, 1) To UBound(vA, 1) - 1
    If vA(i, 1) <> "" Then
        For j = i + 1 To UBound(vA, 1)
            If vA(i, 1) = vA(j, 1) Then
                If vA(i, 2) > vA(j, 2) Then
                    If dRws Is Nothing Then
                        Set dRws = R.Rows(j)
                    Else
                        Set dRws = Union(dRws, R.Rows(j))
                    End If
                Else
                    If dRws Is Nothing Then
                        Set dRws = R.Rows(i)
                    Else
                        Set dRws = Union(dRws, R.Rows(i))
                    End If
                End If
            End If
        Next j
    End If
Next i
If Not dRws Is Nothing Then dRws.Delete
End Sub

 

[ultracyclist]

ADVERTISEMENT

Joe, thank you for the code. I will reply back to the thread to let you know how things look. Need an hour or so to test.

Regards,

Allen

 

[ultracyclist]

Joe,

I just tested the code and it does not seem to be deleting the oldest rows and leaving a single entry per serial number that matches the newest time stamp.

As I reviewed the raw data before running the macro, I'm finding that in some instances there may be 2 or more rows where the serial number fields and the time stamps are identical. In those cases, I would need to ensure the macro does not delete those rows.


Column B Column L
Ex: VMware-42 2a af b9 db 80 9c df-df ab 7d 83 19 7x 4/18/2013 10:09:00 PM
VMware-42 2a af b9 db 80 9c df-df ab 7d 83 19 7x 4/18/2013 10:09:00 PM

Thoughts

Allen

 

[ultracyclist]

ADVERTISEMENT

I ran a new report and ran the macro again just to be surey. Too make this functional I need to revise the criteria as follows

1. If the Timestamp in Column L is different, but S/N in column B is the same, delete duplicate rows with the same serial number, but only retain the one with the newest time stamp</SPAN>
2. If two or more rows have the same serial number and identical timestamp do nothing- Do Not Delete.

Hope this helps.

Thanks

Allen

1. </SPAN>

 

[oldbrewer]

my suggestion re testing adjacent rows would be done via a macro, the first part was to clean up the data to keep the coding as simple as possible

 

[oldbrewer]

If the same machine has 3 identical scan times plus one later scan time, do you want them all to remain? (ditto if one early scan time and 3 later identical scan times)

 

[JoeMo]

I ran a new report and ran the macro again just to be surey. Too make this functional I need to revise the criteria as follows

1. If the Timestamp in Column L is different, but S/N in column B is the same, delete duplicate rows with the same serial number, but only retain the one with the newest time stamp
2. If two or more rows have the same serial number and identical timestamp do nothing- Do Not Delete.

Hope this helps.

Thanks

Allen

This should meet the requirements in the above quote. If it does what you want, you can add a final sort on column L to order by time stamp.

Sub RemoveDupRowsConditionally()
Dim lR As Long, R As Range, vA As Variant, dRws As Range
Set R = Range("B1").CurrentRegion
'Sort by Serial Number
R.Sort key1:=[B2], Order1:=xlAscending, Header:=xlYes
vA = R.Value
For i = LBound(vA, 1) To UBound(vA, 1) - 1
    If vA(i, 2) <> "" Then
        For j = i + 1 To UBound(vA, 1)
            If vA(i, 2) = vA(j, 2) Then
                If vA(i, 12) > vA(j, 12) Then
                    If dRws Is Nothing Then
                        Set dRws = R.Rows(j)
                    Else
                        Set dRws = Union(dRws, R.Rows(j))
                    End If
                ElseIf vA(i, 12) < vA(j, 12) Then
                    If dRws Is Nothing Then
                        Set dRws = R.Rows(i)
                    Else
                        Set dRws = Union(dRws, R.Rows(i))
                    End If
                End If
            End If
        Next j
    End If
Next i
If Not dRws Is Nothing Then dRws.Delete
End Sub