• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 236
  • Last Modified:

Excel table pivoting

I have an excel sheet with ~500 groups that look like:

x name
xxxx address
x city, state, country
x phone#

y name
yyyy address
y city
y phone#

it is there a quick way to make it look like this?

xname     xxxxxaddress   xcity  xphone#
yname    yyyyyaddress    ycity  yphone#
wname.......



0
MikeTa
Asked:
MikeTa
3 Solutions
 
nutschCommented:
Can we assume all your groups have four rows, separated by an empty row?
0
 
nutschCommented:
If it is the case, this code should work, assuming your data starts in cell A1

Thomas
Sub ConsolidateRows_MultipleCells()
'takes rows and consolidate one or many cells, based on one or many cells matching with above or below rows.

Dim lastRow As Long, i As Long, j As Long
Dim colMatch As Variant, colConcat As Variant, lColDest As Long

'**********PARAMETERS TO UPDATE****************
Const strMatch As String = "A"    'columns that need to match for consolidation, separated by commas
Const strConcat As String = "B"     'columns that need consolidating, separated by commas
Const lDest As Long = 3     'starting column for the consolidated items
'*************END PARAMETERS*******************

application.ScreenUpdating = False 'disable ScreenUpdating to avoid screen flashes

'format to fit

Columns(1).Insert

For i = 1 To Cells(Rows.Count, 2).End(xlUp).Row Step 5
    Cells(i, 1).Resize(4).Value = Cells(i, 2)
Next i

colMatch = Split(strMatch, ",")
colConcat = Split(strConcat, ",")

Cells(1, 1).CurrentRegion.Sort Key1:=Cells(1, colMatch(0)), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
                    False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
                    :=xlSortNormal


lastRow = range("A" & Rows.Count).End(xlUp).Row 'get last row

lColDest = lDest

For i = lastRow To 2 Step -1 'loop from last Row to one
    
    If Len(Trim(Cells(i, strConcat))) = 0 Then GoTo nxti:
    
    For j = 0 To UBound(colMatch)
        If Cells(i, colMatch(j)) <> Cells(i - 1, colMatch(j)) Then
            lColDest = lDest
            GoTo nxti
        End If
    Next
    
    For j = 0 To UBound(colConcat)
        range(Cells(i, strConcat), Cells(i, 1).End(xlToRight)).Copy Cells(i - 1, 1).End(xlToRight).Offset(, 1)
        lColDest = lColDest + 1
    Next
    
    Rows(i).Delete
    
nxti:
Next

Columns(1).Delete

application.ScreenUpdating = True 'reenable ScreenUpdating
End Sub

Open in new window

0
 
hitsdoshi1Commented:
If the data is in same format, all the groups with 4 rows on column "A" then following code should do the job.

Good Luck!
Sub Tranp()
m = 1
mtarget = 1
Do While m < 65000
    ActiveSheet.Range("B" & mtarget).Value = ActiveSheet.Range("A" & m).Value
    Range("C" & mtarget).Value = Range("A" & m + 1).Value
    Range("D" & mtarget).Value = Range("A" & m + 2).Value
    Range("E" & mtarget).Value = Range("A" & m + 3).Value
    
    Range("A" & m).Value = Null
    Range("A" & m + 1).Value = Null
    Range("A" & m + 2).Value = Null
    Range("A" & m + 3).Value = Null
    
    m = m + 5
    mtarget = mtarget + 1
    If Range("A" & m) = "" Then
        Exit Sub
    End If
Loop
End Sub

Open in new window

0
Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

 
MikeTaAuthor Commented:
sorry but I am a newbe were.  how should I run the scripts ?
0
 
nutschCommented:
goto visual basic editor (Alt + F11)
Insert \ Module
copy code
go back to your workbook
run macro (Alt + f8)
pick macro and run

Voilà

T
0
 
SANTABABYCommented:
You can use this function:

Sub TransposeData(SourceStartRow As Integer, SourceCol As Integer, SourceBlockSize As Integer, TargetStartRow As Integer, TargetStartCol As Integer)
    Dim maxrow As Long
    Dim sr As Integer, sc As Integer, tr As Integer, tc As Integer
    
    maxrow = Cells(Rows.Count, SourceCol).End(xlUp).Row
    sr = SourceStartRow
    tr = TargetStartRow
    While (sr <= maxrow)
        For tc = 0 To (SourceBlockSize - 1)
            Cells(tr, TargetStartCol + tc).Value = Cells(sr, SourceCol).Value
            sr = sr + 1
        Next tc
        tr = tr + 1
    Wend
    
End Sub

Open in new window


Test it by putting all your data in column 1 and invoking:
Sub test()
 Call Transpose(1, 1, 5, 1, 3)
End Sub

Open in new window

0
 
hitsdoshi1Commented:
Open your file and follow the steps below:

1. Press Alt-F11 (VBA will open)
2. From Menu -> Insert -> Module
3. Past the code
4. Close the VBA and go back to Excel worksheet
5. Press Alt-F8 and select the macro (in this case if you paste my macro then it will display Tranp)
and hit run......

There you go
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: Amazon Web Services - Basic

Are you thinking about creating an Amazon Web Services account for your business? Not sure where to start? In this course you’ll get an overview of the history of AWS and take a tour of their user interface.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now