Combing rows to retain latest only the latest data in each column

DarkV

New Member
Joined
Feb 24, 2016
Messages
7
Office Version
  1. 365
Platform
  1. Windows
I have a complex spreadsheet which uses data from several sources, including a Microsoft Form which employees revisit to update details of their training course, store number etc. over time. The main page of this spreadsheet uses Index/Match formulae to summarise info from the various spreadsheets, one of which is the update sheet. However, the formulae are not finding all of the relevant information, and I think this is because there are multiple lines of data with the same user ID, and it's only finind the first one (or last one). I can change this by altering how the data are sorted, but then I'm missing vital information.

Is there a way to combine multiple rows for the same user/staff number retaining only the latest data entered in each column? The data comes from a constant Microsoft form, and so it feels as if using the ID from the form, rather than the date might work best (there can be issues with the dates in mmddyy vs ddmmyy format which due to restrictions in admin access I'm unable to resolve.

In the example data, I'd need one row with the person's name and staff number, but retaining the latest store number and the accepted, start and finish dates for the course onto one line.

This is a simple example; in reality, the worksheet has around 35 columns and there are hundreds of lines of data for around 200 employees.

Any help would be appreciated!
Example Worksheet.png
 
Here is VBA code to do this. It will work very fast even on large number of rows.

VBA Code:
Option Explicit

Sub CombineTraining()
    Dim vIn As Variant, vOut As Variant
    Dim lRi As Long, lC As Long, lRo As Long, UB1 As Long, _
        UB2 As Long, lColSN As Long
    Dim iNr As Integer
    Dim sStaffNr As String
    Dim colSN As Collection
    Dim binStaffOut As Integer, binStaffIn As Integer, iBit As Integer, binResult As Integer
   
   
    'Read full trainingschedule into array
    vIn = Range("A1").CurrentRegion.Value
    'get nr rows & columns
    UB1 = UBound(vIn, 1)
    UB2 = UBound(vIn, 2)
   
    'get column with staffnr
    For lC = 1 To UB2
        If vIn(1, lC) Like "staff number" Then  '<<<< adjust text to exact heading text
            lColSN = lC
            Exit For
        End If
    Next lC
   
    'get nr of staff in table
    Set colSN = New Collection
    On Error Resume Next    'when you add each staffnumber to the collection, _
                            an error will occur if a duplicate nr gets added. _
                            This line tells the code to continue.
    For lRi = 2 To UB1   'skip header row
        sStaffNr = vIn(lRi, lColSN)
        colSN.Add sStaffNr, sStaffNr
    Next lRi
    On Error GoTo 0         'reset error behaviour
    'colSN.count holds the number of staff in the table
    'resize the output array to have a line for the header and each staff member
    ReDim vOut(1 To colSN.Count + 1, 1 To UB2)
   
    'copy the header row
    For lC = 1 To UB2
        vOut(1, lC) = vIn(1, lC)
    Next lC
   
    lRo = 2
    'now go through the table for each staffnr from the bottom up, _
     checking for details in the 4 columns. Stop when all four are filled
    For iNr = 1 To colSN.Count
        sStaffNr = colSN(iNr)
        binStaffOut = 31    '11111 in binary. Using the five 1's in the number as flags for _
                            which of the four columns has been filled plus 1 _
                            for the rest of the staff info
        For lRi = UB1 To 2 Step -1
            If vIn(lRi, lColSN) Like sStaffNr Then
                binStaffIn = 0  'this variable will hold the flags for each of the columns to be copied
                'find which columns contain info in this line
                iBit = 2    '00010 binary this will be used for column Store Nr
                For lC = UB2 - 3 To UB2
                    If Len(vIn(lRi, lC)) Then
                        ' there is an entry in this column, so set the flag it is to be copied
                        binStaffIn = iBit + binStaffIn
                    End If
                    iBit = iBit * 2     'next bit - it will go from 00010 to 00100 to 01000 to 10000
                Next lC
                binResult = binStaffIn And binStaffOut  ' where there is a 1 in the binary number shows which column to copy
                'the AND operator will only keep 1 in those bits where both binStaffIn and binStaffOut have a 1
               
                'now check which columns need to be copied.
                If binStaffOut And 1 Then       ' if binStaffIn has rightmost bit set, this onl happens first time for each staff
                ' copy staff details
                    For lC = 1 To UB2 - 3
                        vOut(lRo, lC) = vIn(lRi, lC)
                    Next lC
                    binStaffOut = binStaffOut Xor 1
                End If
                If binResult And 2 Then 'copy store nr
                    vOut(lRo, UB2 - 3) = vIn(lRi, UB2 - 3)
                End If
                If binResult And 4 Then 'copy accepted date
                    vOut(lRo, UB2 - 2) = vIn(lRi, UB2 - 2)
                End If
                If binResult And 8 Then 'copy started date
                    vOut(lRo, UB2 - 1) = vIn(lRi, UB2 - 1)
                End If
                If binResult And 16 Then    'copy finished date
                    vOut(lRo, UB2) = vIn(lRi, UB2)
                End If
                'turn off the bits already filled out
                binStaffOut = binStaffOut Xor binResult
            End If
        Next lRi
        lRo = lRo + 1   ' increment the row counter for the output array
    Next iNr
    Range("M1").Resize(colSN.Count + 1, UB2).Value = vOut
End Sub
Thanks so much for this. I'll play around with this to match the actual columns in the sheet I have,
 
Upvote 0

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

Forum statistics

Threads
1,224,820
Messages
6,181,154
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top