Transposing Multiple data sets from column to row

B

Bigkidd

Joined
Jul 9, 2011
Messages
1
Reaction score
0
Hi All,

Need help transposing thousands of data in excel, columns to rows.
My data stack looks like;

Sara A Smith
(808) 952-9713
Po Box 17403 Honolulu,
HI 96817

Sara K Smith
(808) 929-8552
Po Box 7063 Ocean View,
HI 96737


So, i have 4 lines of data with 2 lines of space in between..... and i need a function/formula so that i can get the data in either 3 or 4 rows. ... some what like ...

Sandra A Smith (808) 486-3685 98 14-4999 Waiopae Rd Pahoa, HI 96778
Sandra K Smith (808) 373-4795 5615 Haleola St Honolulu, HI 96821

Hoping for a helpful reply.
Thanks to you all in here.
 
Last edited:
apr pillai

apr pillai

Joined
Jul 20, 2011
Messages
16
Reaction score
0
Copy and paste the following VBA Code into the Standard Module of the Workbook with the Address Data and save the workbook:

Code: 
Public Function ParseAddress()
Dim strSheet As Worksheet, strSheet2 As Worksheet
Dim wrkBook As Workbook
Dim Range1 As Range, Range2 As Range
Dim row1 As Long, col1 As Long, indx As Integer
Dim row2 As Long, col2 As Long, j
Dim getAddress(1 To 8), cellItem As Range, getcell
Dim endofDataFlag As Integer

Set wrkBook = ActiveWorkbook
Set strSheet = wrkBook.Worksheets("Sheet1") 'Source Data, modify sheet name if necessary
Set strSheet2 = wrkBook.Worksheets("Sheet2") 'Target Sheet, modify sheet name if necessary
Set Range1 = strSheet.Range("A1:A1000") 'modify range address
row1 = 0: col1 = 0
row2 = 1: col2 = 1
For Each cellItem In Range1
   getcell = cellItem.Value
   If cellItem.Row = row1 Then
      endofDataFlag = endofDataFlag + 1
      If endofDataFlag > 5 Then 'assumes that the end of data reached
          MsgBox "End of Data"
          Exit Function
      End If
      GoTo nextitem
   End If
   If Not IsEmpty(getcell) Then
       indx = indx + 1
       getAddress(indx) = getcell
   Else
       row1 = cellItem.Row + 1
       strSheet2.Activate
       For j = 1 To indx
          strSheet2.Cells(row2, col2).Value = getAddress(j)
          col2 = col2 + 1
       Next
       Calculate
       row2 = row2 + 1
       col2 = 1
       indx = 0
   End If

nextitem:
Next

End Function
The program reads the data from Sheet1 and writes the output in Sheet2. Modify the Code wherever necessary to address correct worksheet and Range values. I tried the code with the sample data you have given and it works.

The program expects two blank lines between address blocks of up to 8 lines and when it reads more than 5 blank lines continuously assumes that the end of data is reached.
 
Top