Transpose data

[jillibillijames]

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

 

[Rick Rothstein]

...and i found few companies come in the same row.

What exactly does this mean? I know your data makes sense to you mainly because you are able to see it, but you must keep in mind that we cannot see it and your loose descriptions are not very helpful in helping us visualize it (at least not to me). At this point, I'm not sure if any of the previous posting solved any part of your original request or, if one of them did, which one. Instead of trying to describe your data to us in words alone, can you post examples that show us what you are referring to? Remember, a picture is worth a thousand words.

 

[moonfish]

The only reason I can come up with for companies ending up in the same row is that the cell between them is not actually blank. If a cell contains a space, or if it contains a formula that evaluates to an empty cell, there's no guarantee that the methods we wrote actually work.

Here's a modified version of my code with a check for cells that contain only spaces.

Sub TransposeCompanies()
    Dim i, j, k As Integer
    j = 1
    k = 0
    
    For i = 1 To ActiveSheet.UsedRange.Rows.Count
        If Application.Trim(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

 

[Jon von der Heyden]

The following code assumes:

1. That when you run it the source sheet is the active sheet
2. That the workbook structure is not protected because it adds a new sheet
3. That the data is in column A of the active sheet

It can support multiple blank rows separating companies data in column A of the source sheet. It will however delete extra blank rows (leaving only 1 blank between).

The nice thing about this method is that if you have a large data set it does not actually loop through each row in the data set. In fact it only has as many iterations as there are company records (i.e. one iteration per record in the output table).

Public Sub HumptyDumptyWasPushed()
    Dim varArray1 As Variant, varArray2 As Variant
    Dim strVals As String
    Dim wks As Worksheet
    Dim lngRow As Long
    
    With Intersect(Columns(1), ActiveSheet.UsedRange)
        On Error Resume Next
            .SpecialCells(xlCellTypeBlanks).Offset(1). _
             SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        On Error GoTo 0
        varArray1 = Application.Transpose(.Value2)
    End With
    
    strVals = Replace$(Join$(varArray1, "|"), "||", vbCrLf)
    
    Set wks = Sheets.Add
    
    For lngRow = 1 To Len(strVals) - Len(Replace$(strVals, vbCrLf, "")) - 1
        varArray2 = Split(Split(strVals, vbCrLf)(lngRow - 1), "|")
        wks.Range("A" & lngRow).Resize(1, UBound(varArray2) + 1).Value = varArray2
    Next lngRow
End Sub

 

[Rick Rothstein]

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

If those blank lines are really blank (that is, empty... no data, no formulas), then the code I posted should work. Can you post the workbook on one of the free file sharing websites on the Internet so we can see first-hand what might be going wrong with our respective offerings?

You can post it online using one of these free posting websites...

Box: http://www.box.net/files
MediaFire: http://www.mediafire.com
FileFactory: http://www.filefactory.com
FileSavr: http://www.filesavr.com
FileDropper: http://www.filedropper.com
RapidShare: http://www.rapidshare.com

Then post the URL they give you for the file back here.

 

[mirabeau]

hi jillibillijames,

Here's another code to include in your already bountiful list of codes to try. You can have any spacing you like (but at least one) between company groups, Data to transpose can start from row2.

Sub transpozeforJBJ()
Dim e As Range, g As Range, k As Long
k = 2  'or whichever row the data start
Set e = Range("A" & k)
Do
    Set g = Range(e, e.End(4))
    Range("C" & k).Resize(, g.Rows.Count) = Application.Transpose(g)
    Set e = e.End(4).End(4)
    k = k + 1
    If e.Row = Rows.Count Then Exit Do
Loop
End Sub

 

[mirabeau]

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

Hey JbJ,

Just on the offchance that what you mean by this is that some companies have just a stand-alone name with space(s) above and below (that is, without any address, tel, etc. listed in that group) then you might try this slightly modified code

Sub transpozethesecond()
Dim e As Range, g As Range, k As Long
k = 2  'or whichever row the data start
Set e = Range("A" & k)
Do
    If e(2) = "" Then Set g = e Else Set g = Range(e, e.End(4))
    Range("C" & k).Resize(, g.Rows.Count) = Application.Transpose(g)
    If e(2) = "" Then Set e = e.End(4) Else Set e = e.End(4).End(4)
    k = k + 1
    If e.Row = Rows.Count Then Exit Do
Loop
End Sub

Maybe something like what you are looking for???

Testing on 400 companies it took me less than one tenth of a second to transpose all of them with this code.