1

In Sheet2

Column C (Plan ID) can have multiple records

Column K (Status) can either be "Approved" or "Rejected"

Column L (Status Date)

I'm trying to make a VBA macro to look through my data in Sheet2 to find the most recent "Approved" Status for each Plan ID and put the whole row of data into Sheet3.

I basically want to remove duplicates but, grab the last approved plan. I think some Max Date function would be helpful but I've never used it before.

phil652
  • 1,484
  • 1
  • 23
  • 48
mcaulifww
  • 3
  • 1
  • 3
  • I would probably Sort it by Plan ID, Status, and Status Date (Oldest to Newest) - Remove all Rows listed Rejected - and go down the page grabbing each approved date when the Plan ID changes – user1274820 May 21 '15 at 15:04

2 Answers2

0

Edit: Updated to meet new requirements.

As I said in my comment, you could do something like this.

It's not the prettiest/fastest code in the world, but it will get the job done:

Sub GetMostRecentApproved()

Application.ScreenUpdating = False
Dim OutputSheet, x, OtherID
OutputSheet = "Sheet3"

'Clear the OutputSheet
Sheets(OutputSheet).Cells.ClearContents

'Copy our data to the output sheet
Sheets("Sheet2").UsedRange.Copy Sheets(OutputSheet).Range("A1")

'Sort by Plan ID, Status, Status Date (Oldest to Newest)
ActiveWorkbook.Worksheets(OutputSheet).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(OutputSheet).Sort.SortFields.Add Key:=Range("C:C"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets(OutputSheet).Sort.SortFields.Add Key:=Range("K:K"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets(OutputSheet).Sort.SortFields.Add Key:=Range("L:L"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(OutputSheet).Sort
    .SetRange Sheets(OutputSheet).UsedRange
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

'x = 2 assumes we have headers
'This pass deletes all non-unique rejected rows
With Sheets(OutputSheet)
    For x = 2 To .UsedRange.Rows.Count
        If UCase(.Range("K" & x)) = "REJECTED" Then
            Set OtherID = Union(.Range("C2:C" & x - 1), .Range("C" & x + 1 & ":C" & .UsedRange.Rows.Count))
            If Not OtherID.Find(.Range("C" & x).Value, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
                .Range("K" & x).EntireRow.Delete
                x = x - 1
            End If
        End If
    Next x

    For x = 2 To .UsedRange.Rows.Count
        If .Range("C" & x) = vbNullString Then Exit Sub
        If .Range("C" & x + 1) = .Range("C" & x) Then
            .Range("C" & x).EntireRow.Delete
            x = x - 1 'careful with that iterator eugene
        End If
    Next x
End With
Application.ScreenUpdating = True

End Sub

Sheet2 Input:

Input

Sheet3 Output:

Output

user1274820
  • 7,786
  • 3
  • 37
  • 74
0

@user1274820 was on the right track with his comment, but I think you could make it even easier on yourself.
An easy way (without writing a macro) would be to:

  • Copy Sheet2
  • Sort by Plan ID > Status (A to Z) > Status Date (Newest to Oldest)
  • Data > Remove Duplicates (only leaving Plan ID checked)
TMH8885
  • 888
  • 6
  • 15
  • I was trying the sort and remove method but two details I left out: First is a plan can have a most recent record that is rejected with one in the past that is approved (I'd want the approved one to get pulled). also if a plan has only one recod that is rejected I'd want that one. – mcaulifww May 21 '15 at 15:48
  • Okay, so can I assume that you need the code edited for this new requirement? – user1274820 May 21 '15 at 16:02
  • Edited the answer to better suit the new requirements, give the new steps a go. – TMH8885 May 21 '15 at 16:03
  • That's one of the way's I've tried it but the issue there is that if the most recent record is rejected, but there is one older than it that is approved, the approved record will get deleted, but I want to get the approved record. I only want the rejected record if it's the only record for that plan. – mcaulifww May 21 '15 at 16:16
  • user this is great. Thanks for the help. I'm getting an error right here Sheets(OutputSheet).Cells.ClearContents I'll be honest I'm not sure what the .Cells thing means. do I need to do any tweaking to this? Edit: actually it looks like the issue is with the (Outputsheet) – mcaulifww May 21 '15 at 16:53
  • It clears the sheet. You can clear it yourself and take that line out – user1274820 May 21 '15 at 16:56
  • @mcaulifww, if you sort by ID > Status > Status Date, the rejected will be on bottom and thus, be the first deleted, regardless of date. So it would abide by this requirement. – TMH8885 May 21 '15 at 16:57
  • Make sure output sheet is set to a sheet that exists – user1274820 May 21 '15 at 16:58
  • TMH he asked for a macro which you can create using the macro recorder and steps you provided – user1274820 May 21 '15 at 16:59
  • hmmm. outputsheet needs to be a sheet that already exists Application.ScreenUpdating = False Dim OutputSheet, x, OtherID OutputSheet = "Sheet3" Sheet3 already exists, but for some reason I get a Subscrip out of range error here: Sheets("Sheet2").UsedRange.Copy Sheets(OutputSheet).Range("A1") – mcaulifww May 21 '15 at 17:03
  • You said the names of your sheets were sheet2 and sheet3, if they're not, you need to update the names. – user1274820 May 21 '15 at 17:05
  • 1
    I get it now!!! Thanks so much for helping! I'm updating it now and if I get hung up I'll let you know. Thank you for taking time out of your day to help a stranger! – mcaulifww May 21 '15 at 17:09