transpose rows to combination of rows and columns

Jaffey · Apr 29th 2013

I've reviewed numerous posts on transposing data but none of them so far deal with a situation quite like this. I've attached a picture that hopefully describes what I'm trying to accomplish better than I can but I'll try; I have 1000's or rows of client account data containing user notes, 1 row for each note. The notes are typically a few sentences in length. Many accounts have numerous notes therefore the same client#/Acct# can appear many times in the data. I need to transpose the data so that each acct# appears only once and the notes are transposed horizontally beside the acct# according to the sequence of the "Other_#" in the column preceding the note. I've tried to show an example below using text as well.
[ATTACH=CONFIG]53337[/ATTACH]

INPUT

CL_NO ACCT# OTHER NOTES
89252 1 1000 Other_1 note1
89252 1 1000 Other_2 note2
89252 1 1001 Other_1 note1
89252 1 1001 Other_2 note2
89252 1 1001 Other_3 note3
89237 1 1002 Other_1 note1
89237 1 1002 Other_2 note2
89237 1 1002 Other_3 note3
89237 1 1002 Other_4 note4

OUTPUT

CL_NO ACCT# Other_1 Other_2 Other_3 Other_4 .....
89252 1000 note1 note2
89252 1001 note1 note2 note3
89252 1002 note1 note2 note3 note4

jindon · Apr 29th 2013

Re: transpose rows to combination of rows and columns

Try

Code

Sub test()
    Dim a, i As Long, ii As Long, n As Long, t As Long
    Dim txt As String, dic As Object, e
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    With Range("a1").CurrentRegion
        a = .Value: t = 2
        With CreateObject("Scripting.Dictionary")
            For i = 1 To UBound(a, 1)
                txt = Join(Array(a(i, 1), a(i, 2)), Chr(2))
                If Not .exists(txt) Then
                    n = n + 1: .Item(txt) = n
                End If
                If i > 1 Then
                    If Not dic.exists(a(i, 3)) Then
                        t = t + 1: dic(a(i, 3)) = t
                    End If
                End If
            Next
            ReDim b(1 To n, 1 To t)
            For Each e In dic
                b(1, dic(e)) = e
            Next
            For i = 1 To UBound(a, 1)
                txt = Join(Array(a(i, 1), a(i, 2)), Chr(2))
                For ii = 1 To 2
                    b(.Item(txt), ii) = a(i, ii)
                Next
                If i > 1 Then b(.Item(txt), dic(a(i, 3))) = a(i, 4)
            Next
        End With
        With .Offset(, .Columns.Count + 1).Resize(n, t)
            .CurrentRegion.ClearContents
            .Value = b
        End With
    End With
End Sub

Display More

Jaffey · May 1st 2013

Re: transpose rows to combination of rows and columns

It's working but it keeps crashing. I've attached screenshots of the errors. Please note some of the user notes may consist of nothing but an asterisk, or sometimes just a period, or a line "===", or any other character, or sometimes nothing.[ATTACH=CONFIG]53400[/ATTACH][ATTACH=CONFIG]53401[/ATTACH]

jindon · May 2nd 2013

Re: transpose rows to combination of rows and columns

What is the version of your Excel?

If it is 2003 or earlier, columns in result have 354(t=354), so unable to handle.

Jaffey · May 2nd 2013

Re: transpose rows to combination of rows and columns

I have eXCEL 2007. When I manually delete the rows with blanks, #N/A, asterisks, "=", etc. it runs fine and copies data over/across 600 columns. Ex. "OTHER_650"

Jaffey · May 2nd 2013

Re: transpose rows to combination of rows and columns

Also, I notied about 100 entries where the user had entered "=========" and nothing else. It stops on all of those.

jindon · May 2nd 2013

Re: transpose rows to combination of rows and columns

I need to see your file then...

Jaffey · May 2nd 2013

Re: transpose rows to combination of rows and columns

forum.ozgrid.com/index.php?attachment/53411/ On my machine if I delete row 10 it works

jindon · May 2nd 2013

Re: transpose rows to combination of rows and columns

Change

Code

If i > 1 Then b(.Item(txt), dic(a(i, 3))) = a(i, 4)

to

Code

If i > 1 Then b(.Item(txt), dic(a(i, 3))) = "'" & a(i, 4)

Jaffey · May 2nd 2013

Re: transpose rows to combination of rows and columns

That fixed 99% of the issues. The only snag now is it halts when the cell contains #VALUE! (residue from some pre-processing before I receive the file)

jindon · May 2nd 2013

Re: transpose rows to combination of rows and columns

I said.....

Quote from jindon;662929

I need to see your file then...

Jaffey · May 3rd 2013

Re: transpose rows to combination of rows and columns

forum.ozgrid.com/index.php?attachment/53442/
Here's an example of notes it's catching on. The notes were entered with an equals sign as the first char and excel is treating them as invalid formulas. I tried formatting them as text but it made no difference.

jindon · May 3rd 2013

Re: transpose rows to combination of rows and columns

What do you want to do with those rows?

Jaffey · May 3rd 2013

Re: transpose rows to combination of rows and columns

Treat them like the other rows if possible. i.e. Ignore the equals sign and move the text where it belongs based on the Other_# value.

jindon · May 3rd 2013

Re: transpose rows to combination of rows and columns

Change to

Code

Sub test()
    Dim a, i As Long, ii As Long, n As Long, t As Long
    Dim txt As String, dic As Object, e
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    With Range("a1").CurrentRegion
        a = .Formula: t = 2
        With CreateObject("Scripting.Dictionary")
            For i = 1 To UBound(a, 1)
                txt = Join(Array(a(i, 1), a(i, 2)), Chr(2))
                If Not .exists(txt) Then
                    n = n + 1: .Item(txt) = n
                End If
                If i > 1 Then
                    If Not dic.exists(a(i, 3)) Then
                        t = t + 1: dic(a(i, 3)) = t
                    End If
                End If
            Next
            ReDim b(1 To n, 1 To t)
            For Each e In dic
                b(1, dic(e)) = e
            Next
            For i = 1 To UBound(a, 1)
                txt = Join(Array(a(i, 1), a(i, 2)), Chr(2))
                For ii = 1 To 2
                    b(.Item(txt), ii) = a(i, ii)
                Next
                If i > 1 Then
                    If a(i, 4) Like "=-*" Then
                        b(.Item(txt), dic(a(i, 3))) = Trim$(Mid$(a(i, 4), 3))
                    Else
                        b(.Item(txt), dic(a(i, 3))) = "'" & a(i, 4)
                    End If
                End If
            Next
        End With
        With .Offset(, .Columns.Count + 1).Resize(n, t)
            .CurrentRegion.ClearContents
            .Value = b
        End With
    End With
End Sub

Display More

Jaffey · May 4th 2013

Re: transpose rows to combination of rows and columns

It's working perfectly now. Thank you so much.

transpose rows to combination of rows and columns

Participate now!

Share