Removing secondary entries

atilla · #1 07-10-2011, 11:28 PM

Hi Folks
Not the greatest expert on VBA/macro's so all assistance greatly welcomed.

I have a list consisting of events, the columns are:
Date, time, location, name.

This list can be dated anywhere between a couple of days and several weeks long.
Each user may appear several times on each date.

What i need to do is condense the list down is to show each user only once for each date. Additionally this is to be restricted to between certain hours. eg. 18:30 to 07:00.

Any suggestions and advice would be much appreciated.

Sample file attached.

macropod · #2 07-15-2011, 09:34 PM

Hi atilla,

Try the following macro:

Code:

Sub Cleanup()
Application.ScreenUpdating = False
Application.Calculation = xlManual
Dim i As Long, LastRow As Long
With ActiveSheet
  LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
  For i = LastRow To 2 Step -1
    If CDate(.Range("B" & i).Value) < CDate("7:00:00") Then
      .Range("A" & i).EntireRow.Delete
    End If
    If CDate(.Range("B" & i).Value) > CDate("18:00:00") Then
      .Range("A" & i).EntireRow.Delete
    End If
  Next
  LastRow = .Range("A" & .Cells.SpecialCells(xlCellTypeLastCell).Row).End(xlUp).Row
  With .Sort
    With .SortFields
      .Clear
      .Add Key:=Range("A1:A" & LastRow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
      .Add Key:=Range("D1:D" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
      .Add Key:=Range("B1:B" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    End With
    .SetRange Range("A1:D" & LastRow)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With
  For i = LastRow To 2 Step -1
    If .Range("A" & i).Value & .Range("D" & i).Value = .Range("A" & i - 1).Value & .Range("D" & i - 1).Value Then
      .Range("A" & i).EntireRow.Delete
    End If
  Next
End With
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub

Note: As coded, the macro -
1. deletes entries before 7AM and after 6PM. Modify the '7:00:00' and '18:00:00' to suit your needs.
2. preserves only the earliest valid entry for users with multiple entries on the same date. To keep only the last valid entry, change the last instance of 'xlAscending' to 'xlDescending'.

atilla · #3 07-16-2011, 04:27 PM

@ macropod

Thank for the above assistance, it is much appreciated. Unfortunately i'm looking to find the entries before tam and after 6pm.
Playing about with the times and/or the <> operators to achieve correct results just returns a blank sheet. Any further pointers that may help?

macropod · #4 07-16-2011, 07:17 PM

Hi atilla,

Try replacing:

Code:

    If CDate(.Range("B" & i).Value) < CDate("7:00:00") Then
      .Range("A" & i).EntireRow.Delete
    End If
    If CDate(.Range("B" & i).Value) > CDate("18:00:00") Then
      .Range("A" & i).EntireRow.Delete
    End If

with:

Code:

    If CDate(.Range("B" & i).Value) > CDate("7:00:00") Then
      If CDate(.Range("B" & i).Value) < CDate("18:00:00") Then
        .Range("A" & i).EntireRow.Delete
      End If
    End If

atilla · #5 07-17-2011, 07:29 AM

@ macropod
Sir, you are a star.
Many thanks for kind help.

I'm going to have to start learning this stuff me thinks.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Removing Custom XML	Ulodesk	Word	0	06-24-2011 09:01 AM
Sent foder in secondary email account	zoran32	Outlook	1	04-25-2011 03:29 PM
Secondary IP address Outlook Fail-over	danish.mustafa	Outlook	0	03-01-2010 01:32 AM
Removing All Formating	basscarp	Word	0	01-31-2010 05:49 PM
Applying And Removing Letterhead	skoz55	Word	0	08-06-2009 10:22 PM