Transpose data

J

jillibillijames

Board Regular
Joined
Apr 19, 2011
Messages
66
Hi,

i have data in this format.

<TABLE style="WIDTH: 48pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=64><COLGROUP><COL style="WIDTH: 48pt" width=64><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 48pt; HEIGHT: 15pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20 width=64>company</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20>address</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20>tel</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20>contact</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20> </TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20>company</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20>address</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20>tel</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20>contact</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20>email</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20>fax</TD></TR></TBODY></TABLE>
there are nearly 400 companies in this format with blank cell between the first company details and the second. i wanted this data to be placed in rows. there are too many to use transpose option.

can anyone help me out of this.

Thanks in advance.

James
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Sort by date Sort by votes
Assuming all your data is in column A, starting at A1, this will put the transposed values in columns C and upward.
Code: 
Sub TransposeCompanies()
    Dim i, j, k As Integer
    j = 1
    k = 0
    
    For i = 1 To ActiveSheet.UsedRange.Rows.Count
        If Cells(i, 1).Value = "" Then
            j = j + 1
            k = 0
        Else
            Cells(j, 3 + k) = Cells(i, 1)
            k = k + 1
        End If
    Next i
End Sub
 
Upvote 0
This places the results in a new sheet, and must be triggered while the sheet with this data is the active sheet:

Code: 
Public Sub Boooooooooooo()
    Dim varArray1 As Variant, varArray2 As Variant
    Dim strVals As String
    Dim wks As Worksheet
    Dim lngRow As Long
    
    varArray1 = Application.Transpose(Intersect(Columns(1), ActiveSheet.UsedRange).Value2)
    strVals = Replace$(Join$(varArray1, ","), ",,", vbCrLf)
    
    Set wks = Sheets.Add
    
    For lngRow = 1 To Len(strVals) - Len(Replace$(strVals, vbCrLf, ""))
        varArray2 = Split(Split(strVals, vbCrLf)(lngRow - 1), ",")
        wks.Range("A" & lngRow).Resize(1, UBound(varArray2) + 1).Value = varArray2
    Next lngRow
End Sub
 
Last edited:
Upvote 0
Hi jillibillijames,

The same assumption, data is in column A and begins in A1. Transposed data will be showed beginning in column B.
Code: 
Sub Transpose()
Dim wf As WorksheetFunction, m As Integer, O As Integer, c As Integer

Set wf = WorksheetFunction
m = 1: O = 1
For Each r In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    If r.Address = "$A$2" Or IsEmpty(Range(r.Address).Offset(-1, 0)) Then
        c = Range(r.Address).End(xlDown).Row - r.Row + 1 + O
        Cells(m, "B").Resize(, c) = wf.Transpose(Range(r.Address).CurrentRegion)
        m = m + 1
    End If
    O = 0
Next
End Sub
Regards
 
Upvote 0
One more...

Code: 
Sub TransposeData()
  Dim LastRow As Long, A As Range
  Const StartRow As Long = 2
  Const DataCol As String = "A"
  LastRow = Cells(Rows.Count, DataCol).End(xlUp).Row
  For Each A In Cells(StartRow, DataCol).Resize(LastRow - StartRow + 1).SpecialCells(xlCellTypeConstants).Areas
    A(1).Resize(, A.Rows.Count) = WorksheetFunction.Transpose(A.CurrentRegion)
  Next
  Cells(StartRow, DataCol).Offset(, 1).Resize(LastRow - StartRow + 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Before you run the code, set the two constants (Const statements) to match your set up (StartRow is first company's row number, DataCol is the column your data is in).
 
Upvote 0
Rich (BB code): 
Sub TransposeCompanies()
    Dim i, j, k As Integer
    j = 1
    k = 0
    
    For i = 1 To ActiveSheet.UsedRange.Rows.Count
        If Cells(i, 1).Value = "" Then
            j = j + 2
            k = 0
        Else
            Cells(j, 3 + k) = Cells(i, 1)
            k = k + 1
        End If
    Next i
End Sub
This way it adds a blank line between each entry. If you want more blank lines between each entry, change the value colored red in the above code.

If you want the transposed data to be directly adjacent to its original data, replace the red value with k + 1.
 
Last edited:
Upvote 0
jillibillijames said:
it worked. Can you please give me a code for the data with multiple blanks in between.
Click to expand...
You should really try all of the code offerings you receive to questions you ask. Had you done that, you would have found that the code I offered you already has the functionality you are now asking for built into it. I haven't looked at the other solutions myself (no reason for me to have as it was not my question), but it is possible that one or more of them might also already do it too.
 
Upvote 0
Rick Rothstein said:
You should really try all of the code offerings you receive to questions you ask. Had you done that, you would have found that the code I offered you already has the functionality you are now asking for built into it. I haven't looked at the other solutions myself (no reason for me to have as it was not my question), but it is possible that one or more of them might also already do it too.
Click to expand...
Okay, I just looked at moonfish's response and see that he interpretted your latest question differently from the way I did. When you said "Can you please give me a code for the data with multiple blanks in between", did you mean you wanted the code to be able to handle multiple blank lines between your existing data (which is what I assumed you meant) or that you wanted the output from our code to produce transformed data with more than one blank line between the output (which is what moonfish assumed you meant)?
 
Upvote 0
Hi,

I just checked my entire data and i found few companies come in the same row. I also tried with other codes as well but showing runtime error "9" and "1004". I managed deleting multiple blanks and maintained only single blank.

Can anyone please help me out.

And thanks everyone for the quick reply to my query.

Regards
JillibilliJames
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
VBA Function to Paste Table into Outlook Email Resulting in HTML language in Email
Replies
8
Views
613
smozgur
smozgur
A
  • Question Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
2K
Attrazion
A
C
  • Question Question
Macro Help - Transposing Some Data from Columns to Rows, Accounting for Duplicate Data
Replies
1
Views
125
Kaper
Kaper
G
  • Question Question
Using Excel formula to create HTML code text referencing specific cells
Replies
0
Views
1K
gvsumich
G
E
  • Question Question
VBA code clean up
Replies
9
Views
573
mumps
mumps

Forum statistics

Threads
1,224,505
Messages
6,179,151
Members
452,891
Latest member
JUSTOUTOFMYREACH

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top