Data Sorting

[iksotof]

Hello

I have been presented with a workbook of clients and details about their appointments and need to analyse by the employee who looks after each client. Trouble is the data is presentented in a none helpful state, with the month (detailed just once in one column), then in the next column, listed is the employee initials (again just once for the month) and the clients names under that employee initals in the same column. Adjacent to each client are few more columns that provide some commentary on the appointment. I have 1000's of these records going back a few years, I attach an extract example. Sheet A shows the raw data and B how i would like it to look when ordered or somethign similar, I have noe issue with all initals and dates repeating on each line if needs be. Is there a way I can do this quite quickly, either with formula or with some filter type feature, I'm not envying the propsect of having to do it manaully.

Many thanks in advance
Darren.

[HansV]

Here is a macro you can run. Create a copy of the workbook first.

Code: Select all

Sub Transform()
    Dim r As Long
    Dim m As Long
    Dim d As Date
    Dim s As String
    Application.ScreenUpdating = False
    m = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("A2:A" & m).NumberFormat = Range("A2").NumberFormat
    r = 2
    Do
        If Range("A" & r).Value <> "" Then
            d = Range("A" & r).Value
            Range("A" & r).ClearContents
        ElseIf Len(Range("B" & r).Value) = 2 Then
            s = Range("B" & r).Value
            Range("B" & r).ClearContents
        ElseIf Range("B" & r).Value <> "" Then
            Range("A" & r).Value = d
            Range("B" & r).Insert Shift:=xlShiftToRight
            Range("B" & r).Value = s
        End If
        r = r + 1
    Loop Until r > m
    For r = m To 2 Step -1
        If Range("A" & r).Value = "" Then
            Range("A" & r).EntireRow.Delete
        End If
    Next r
    Application.ScreenUpdating = True
End Sub

[snb]

Try:

Code: Select all

Sub M_snb()
   sn = Sheet1.UsedRange.Resize(, 4)
   
   For j = 2 To UBound(sn)
     If sn(j, 1) = "" And Len(sn(j, 2)) > 2 Then sn(j, 1) = c00
     If sn(j, 1) <> "" Then c00 = sn(j, 1)
     If Len(sn(j, 2)) = 2 And sn(j, 3) = "" Then c01 = sn(j, 2)
     If Len(sn(j, 2)) > 2 Then sn(j, 4) = c01
     If Len(sn(j, 2)) = 2 Then sn(j, 2) = ""
   Next
   
   Sheet1.Cells(1, 6).Resize(UBound(sn), 4) = sn
End Sub

[iksotof]

Thank you Hans, phenomenal as ever.

Best Darren.