Macro to convert rows to columns

[Riaang]

Hi there,

Can anyone help me to write a macro that can convert rows into columns. I have a excel spreadsheet and in column A is the member number. From B to E will be the rest of the detail. On the second line or row the member number will repeat in column A but in column B to E is different information for the member than in row 1.

I want all the information of the member to be in one line. Some member have only 2 lines whereby other members can have more than that.

Any help will be appreciated.

Thanks

 

[jOSEFFB]

Tested:

I keep getting a Command cannot be completed with the specified range.

'Acquisition of all different records
>>AllRange.Columns(1).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set OneCopyRange = AllRange.Columns(1).SpecialCells(xlCellTypeVisible)

is highlighted on debug.

I've renamed the sheets sheet(1) for data and sheet(2) (tried other ways too)
still nothing.

 

[chiello]

The code works fine on my workbook, I can tell you to copy again the code, execute it again, and if an error occurs, enter in debug mode.
At this time verify the values of Sheet1LastRow and of CopyColTo, These variables set AllRange dimension.
This could be wrong because you Sheet is different from mine.

Wait for response...

 

[chiello]

I'm optimist, I'm sure this time is good for you.

The problem was that my data were shifted 5 rows above respect to yours.

The code below (should) suit your request:

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> Macro6()
<SPAN style="color:#007F00">'</SPAN>
<SPAN style="color:#007F00">' Macro6 Macro</SPAN>
<SPAN style="color:#007F00">' Macro registrata il 24/01/2005 da FSC</SPAN>
<SPAN style="color:#007F00">'</SPAN>

<SPAN style="color:#007F00">'</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> Sheet1LastRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, Sheet2RowPointer <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, PointerIncr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> AllRange <SPAN style="color:#00007F">As</SPAN> Range, OneCopyRange <SPAN style="color:#00007F">As</SPAN> Range
<SPAN style="color:#00007F">Dim</SPAN> CELLi <SPAN style="color:#00007F">As</SPAN> Range, RangeToCopy <SPAN style="color:#00007F">As</SPAN> Range
<SPAN style="color:#00007F">Dim</SPAN> CopyColFrom <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, CopyColTo <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> StrMarking <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>

Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN>

<SPAN style="color:#007F00">'Sheets 2 cleaning</SPAN>
Sheets(2).Cells.Delete

<SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN>
Sheets(1).ShowAllData
<SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0

<SPAN style="color:#007F00">'Last row index acquisition</SPAN>
Sheet1LastRow = Sheets(1).Cells(Cells.Rows.Count, 1).End(xlUp).Row
<SPAN style="color:#007F00">'Initialization of Pointer to first blank row in Sheet 2</SPAN>
Sheet2RowPointer = 1

<SPAN style="color:#007F00">'Set Columns Number to copy</SPAN>
CopyColFrom = 5 <SPAN style="color:#007F00">'First</SPAN>
CopyColTo = Sheets(1).Range("A5").End(xlToRight).Column <SPAN style="color:#007F00">'Last</SPAN>

<SPAN style="color:#007F00">'Data range acquisition</SPAN>
<SPAN style="color:#00007F">Set</SPAN> AllRange = Sheets(1).Range(Sheets(1).Range("A5"), Sheets(1).Cells(Sheet1LastRow, CopyCol<SPAN style="color:#00007F">To</SPAN>))

<SPAN style="color:#007F00">'Acquisition of all different records</SPAN>
AllRange.Columns(1).AdvancedFilter Action:=xlFilterInPlace, Unique:=<SPAN style="color:#00007F">True</SPAN>
<SPAN style="color:#00007F">Set</SPAN> OneCopyRange = AllRange.Columns(1).SpecialCells(xlCellTypeVisible)

<SPAN style="color:#007F00">'Momently clear column A cells relevant to Comments</SPAN>
<SPAN style="color:#00007F">For</SPAN> PointerIncr = 9 To Sheet1LastRow <SPAN style="color:#00007F">Step</SPAN> 5
    Sheets(1).Cells(PointerIncr, 1).ClearContents
<SPAN style="color:#00007F">Next</SPAN> PointerIncr

<SPAN style="color:#007F00">'Setting of PointerIncr to be used after the copy procedure</SPAN>
PointerIncr = CopyColTo - CopyColFrom + 1

<SPAN style="color:#007F00">'Filter all different records</SPAN>
AllRange.AutoFilter
<SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> CELLi <SPAN style="color:#00007F">In</SPAN> OneCopyRange
    Sheets(1).Activate
    <SPAN style="color:#007F00">'Skip A1 and empty cells</SPAN>
    <SPAN style="color:#00007F">If</SPAN> CELLi.Row <> 5 And Trim(CELLi) <> "" <SPAN style="color:#00007F">Then</SPAN>
        AllRange.AutoFilter Field:=1, Criteria1:=CELLi
        
        <SPAN style="color:#007F00">'Acquisition of Marking String Data</SPAN>
        StrMarking = AllRange.Columns(4).SpecialCells(xlCellTypeVisible).Cells(2, 1)
        
        <SPAN style="color:#007F00">'Range to copy acquisition</SPAN>
        <SPAN style="color:#00007F">Set</SPAN> RangeToCopy = _
            Range(AllRange.Columns(CopyColFrom), AllRange.Columns(CopyColTo)).SpecialCells(xlCellTypeVisible)
            
        <SPAN style="color:#007F00">'Copy data</SPAN>
        Range<SPAN style="color:#00007F">To</SPAN>Copy.Copy
        Sheets(2).Activate
        Sheets(2).Cells(Sheet2RowPointer, 3).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=<SPAN style="color:#00007F">True</SPAN>
        Sheets(1).Range("A5").Copy Destination:=Sheets(2).Cells(Sheet2RowPointer, 1)
        Sheets(1).Range("A6").Copy
        Sheets(2).Range(Cells(Sheet2RowPointer + 1, 1), Cells(Sheet2RowPointer + PointerIncr - 1, 2)).PasteSpecial _
            Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Sheets(2).Range(Cells(Sheet2RowPointer + 1, 1), Cells(Sheet2RowPointer + PointerIncr - 1, 1)) = CELLi
        Sheets(1).Range("D5").Copy Destination:=Sheets(2).Cells(Sheet2RowPointer, 2)
        Sheets(2).Range(Cells(Sheet2RowPointer + 1, 2), Cells(Sheet2RowPointer + PointerIncr - 1, 2)) = StrMarking
        <SPAN style="color:#007F00">'Increment of the pointer for next copy</SPAN>
        Sheet2RowPointer = PointerIncr + Sheet2RowPointer
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">Next</SPAN> CELLi

<SPAN style="color:#007F00">'Columns Width Adjustment (Autofit)</SPAN>
<SPAN style="color:#00007F">With</SPAN> Sheets(2).Columns("A:F")
    .ColumnWidth = 100
    .AutoFit
    .Rows.AutoFit
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>

Sheets(1).Activate
<SPAN style="color:#007F00">'Clear Filter</SPAN>
<SPAN style="color:#007F00">'Sheets(1).ShowAllData</SPAN>
AllRange.AutoFilter
<SPAN style="color:#007F00">'Restore column A cells relevant to Comments</SPAN>
<SPAN style="color:#00007F">For</SPAN> PointerIncr = 9 To Sheet1LastRow <SPAN style="color:#00007F">Step</SPAN> 5
    Sheets(1).Cells(PointerIncr, 1) = Sheets(1).Cells(PointerIncr - 1, 1)
<SPAN style="color:#00007F">Next</SPAN> PointerIncr
Sheets(1).Activate
Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>


</FONT>

Ciaoooo

 

[HalfAce]

chiello,
Now that's what I call putting your heart & soul into this stuff!
I like your spirit.


Dan

 

[jOSEFFB]

He deserves a automatic MVP status.

--I'm still decoding this code LOL

Thanks.