CODEWITHSUNDEEP
vbaexcelconsolidation
Russ
Russ

Reputation: 47

Use Excel VBA to find column matches & merge based on the values of two other column

I have a little conundrum here & while there's a few suggestions on the site, there's nothing that quite fits the bill for me. I need to merge some rows based on the values of some cells in the row.

I guess I need some sort of code that matches the name then searches for a 'New Starter' entry with that same name.

Here's how my data (Shift, name, detail) looks:

09:00-17:00 Smith John      Present
09:00-11:00 Smith John      New Starter
11:10-13:00 Smith John      New Starter
14:00-17:00 Smith John      New Starter
09:00-17:00 Connor Sarah    Present
09:00-11:00 Connor Sarah    New Starter
11:10-13:00 Connor Sarah    New Starter
14:00-17:00 Connor Sarah    New Starter
09:00-17:00 Claus Santa     Present
10:00-18:00 Mouse Mickey    Present
10:00-11:00 Mouse Mickey    New Starter
11:10-13:00 Mouse Mickey    New Starter
14:00-18:00 Mouse Mickey    New Starter

I need to remove the New Starter lines (If they exist) but also replace their 'Present' cell with 'New Starter' (Although this can be different text if needed):

09:00-17:00 Smith John      New Starter
09:00-17:00 Connor Sarah    New Starter
09:00-17:00 Claus Santa     Present
10:00-18:00 Mouse Mickey    New Starter

You can see here that Santa is not a New Starter & therefore stays as 'Present'.

Essentially, the 'New Starter' lines are not needed, but I do want to give new starters a different detail to the present staff.

Additional notes:

Upvotes: 2

Views: 1608

Answers (2)

Chrismas007
Chrismas007

Reputation: 6105

The following code should address your conditions. Tested Working.

Sub RemoveDups()

Dim CurRow As Long, LastRow As Long, SrchRng As Range

LastRow = Range("A" & Rows.Count).End(xlUp).Row

    Range("A1:C" & LastRow).Select
    Sheets(1).Sort.SortFields.Clear
    Sheets(1).Sort.SortFields.Add Key:=Range("B2:B" & LastRow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    Sheets(1).Sort.SortFields.Add Key:=Range("C2:C" & LastRow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Sheets(1).Sort
        .SetRange Range("A1:C" & LastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

For CurRow = LastRow To 2 Step -1
    If Range("C" & CurRow).Value = "Present" Then
        If CurRow <> 2 Then
            If Not Range("B2:B" & CurRow - 1).Find(Range("B" & CurRow).Value, LookIn:=xlValues, LookAt:=xlWhole) is Nothing Then
                Range("C" & CurRow).Value = "New Starter"
            End If
        End If
    ElseIf Range("C" & CurRow).Value = "New Starter" Then
        Range("C" & CurRow).EntireRow.Delete xlShiftUp
    End If
Next CurRow

End Sub

Upvotes: 2

barryleajo
barryleajo

Reputation: 1952

A second method for you to consider, perhaps a bit more 'generic' and 'portable' in terms of the location of your data. If you want to sort the data before consolidating, then this uses the alternative (more long-standing?) Range.Sort method compatible back to Excel 2003. Further parameters to refine this method can be found in the msdn reference, here

Option Explicit
Sub newStarters()
Dim ws As Worksheet
Dim dRng As Range
Dim stRow As Long, endRow As Long, nameCol As Long, c As Long
Dim nme As String, changeStr As String

'explicitly identify data sheet
Set ws = Sheets("Data")
'start row of data
stRow = 2
'column number of "Name"
nameCol = 3
'set changeStr
changeStr = "New Starter"

    'Use the explicit data sheet
    With ws
        'find last data row
        endRow = .Cells(Rows.Count, nameCol).End(xlUp).Row

        'if you want the data to be sorted before consolidating
        '======================================================
        'Set dRng = .Range(.Cells(stRow, nameCol).Offset(0, -1), _
        '            .Cells(endRow, nameCol).Offset(0, 1))

        'dRng.Sort Key1:=.Cells(stRow, nameCol), Order1:=xlAscending, _
        '          Key2:=.Cells(stRow, nameCol).Offset(0, 1), Order2:=xlDescending, _
        '          Header:=xlNo
        '======================================================
            'consolidate data
            For c = endRow To stRow Step -1
                With .Cells(c, nameCol)
                    nme = .Value
                        If .Offset(0, 1).Value = changeStr Then
                            If .Offset(-1, 0).Value = nme Then
                                .Offset(-1, 1).Value = changeStr
                                .EntireRow.Delete xlShiftUp
                            End If
                        End If
                End With
            Next c
    End With

End Sub

Upvotes: 1

Related Questions