split & transpose columns to rows?

**toniv** · 05-17-2012, 04:38 PM

HI,

Looking for some help please, I've been playing with formula to do this and I know I can copy, paste special, transpose. But wanted a quicker way to automate this process.

I've attached a simple worksheet, similar to that which I'm working on (the real thing has 4000 rows and apprx 20 columns!).

I need to produce the data in column B against each individual named in column A, I've used the simple IF function in column C to be able to produce a 'false' so I can establish where each range begins and ends as each range is different.

Thanks
T

**rvasquez** · 05-17-2012, 04:55 PM

Hello there,

What did you want your results to look like?

**FDibbins** · 05-17-2012, 05:18 PM

Hard to see what you are after

all you have in the attached workbook is a short list of 1st names, weeksays and a true/false formua?

**toniv** · 05-18-2012, 03:00 PM

Thanks for replying - Sorry, data I'm working with is person identifiable so can't attach it.

Basically I've got approx 4000 rows of dates of service contacts with patients and each
date has an identifier next to it - I've got approx 500 individuals in the data. What I
want in the results is a row of dates per patient so that I'll only have approx 500
unique rows with identifiers in column A and dates starting in column B and stretching
across columns as far as they need to for each individual.

Which is why I mocked up this really simole version of my data to share with you .....
Thought it might help!

**jindon** · 05-18-2012, 03:26 PM

try

Sub test()
    Dim a, b(), i As Long, n As Long
    Dim AL As Object
    Set AL = CreateObject("System.Collections.ArrayList")
    a = Sheets("info").Range("a1").CurrentRegion.Value
    For i = 1 To UBound(a, 1)
        If Not AL.Contains(a(i, 2)) Then AL.Add a(i, 2)
    Next
    ReDim b(1 To UBound(a, 1), 1 To AL.Count)
    n = n + 1
    For i = 0 To AL.Count - 1
        b(n, i + 1) = AL(i)
    Next
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 1 To UBound(a, 1)
            If Not .exists(a(i, 1)) Then
                n = n + 1
                .Item(a(i, 1)) = n
            End If
            b(.Item(a(i, 1)), AL.IndexOf(a(i, 2), 0) + 1) = a(i, 1)
        Next
    End With
    With Sheets("result").Cells(1).Resize(n, AL.Count)
        .CurrentRegion.Clear
        .Value = b
    End With
    Set AL = Nothing
End Sub