I'd been asked by Registry to help them with a data problem (they'd asked IT Services and for some reason they said ask me). My response was that I didn't know enough about Excel so couldn't help - but they replied to say that they were really stuck and didn't have anyone else to ask as the member of staff who'd been responsible for it in previous years had left, so I agreed to have a look. The problem involved allocating guests to seats for graduation ceremonies. On the sample data I was given there were nearly 500 graduands each requiring seats for between zero and four guests. They wanted the name of the graduand repeating the same number of times as they'd requested seats for their guests (here's a sample of similar data). I sent out a quick tweet as follows...
...and very quickly I had a number of helpful responses (several from Leicester, one from Macclesfield and one from Milton Keynes)
But not having fixed the problem I put up a quick blog post on Can you help with an Excel problem? To which I got more responses from Leicester plus Plymouth, and Hamilton, New Zealand. But I got more than just tweets - four people very kindly emailed me Excel spreadsheets or links to Google spreadsheets showing how I could tackle the problem - including staff at Leicester (thanks Rick and Hazel) a friend who's a teacher (thanks Chris) and a member of staff from Imperial College London (thanks Moira). I was overwhelmed with people's helpfulness!
Most suggested solutions involved list functions like =IF($C1>1,$A1,"") which did the job of repeating the surnames the required number of times but then would have involved me converting the columns to rows.
The most comprehensive and elegant solution (within three hours of my original tweet) came from a third year computer science student at Leicester, Chris Bunney, who went to the trouble of writing the following macro using visual basic.
Sub InsertSurnames()
Dim LastRow As Long
Dim r As Long
Dim surname As String
Dim tickets As Integer
Dim surnameCol As Integer
Dim ticketCol As Integer
Dim targetCol As Integer
surnameCol = 1
ticketCol = 3
targetCol = 4
LastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
r = 1
Do While r <= LastRow
surname = Cells(r, surnameCol).Value
tickets = Cells(r, ticketCol).Value
If (Not (Len(surname) = 0)) Then
Cells(r, targetCol).Value = surname
For x = 1 To tickets - 1
Cells(r + x, 1).EntireRow.Insert
Cells(r + x, targetCol).Value = surname
Next x
LastRow = LastRow + tickets - 1
End If
r = r + 1
Loop
End Sub
And it worked an absolute treat. So thanks everyone for your contributions - I really appreciate them. Another good example of the power of networks. And by the way, Chris Bunney, having graduated, is currently looking for jobs...
Sub InsertSurnames()
Dim LastRow As Long
Dim r As Long
Dim surname As String
Dim tickets As Integer
Dim surnameCol As Integer
Dim ticketCol As Integer
Dim targetCol As Integer
surnameCol = 1
ticketCol = 3
targetCol = 4
LastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
r = 1
Do While r <= LastRow
surname = Cells(r, surnameCol).Value
tickets = Cells(r, ticketCol).Value
If (Not (Len(surname) = 0)) Then
Cells(r, targetCol).Value = surname
For x = 1 To tickets - 1
Cells(r + x, 1).EntireRow.Insert
Cells(r + x, targetCol).Value = surname
Next x
LastRow = LastRow + tickets - 1
End If
r = r + 1
Loop
End Sub
