Transpose single column of data to multiple columns at blank row breaks

[chzhd4life]

Help, have multiple very long "tables" of data in a single column. Need to transpose/convert to standard table format. Entries are divided by blank row or rows. Not all entries have same pieces of data, e.g., some have Name, Address, City/ST/Zip, Phone, email, website URL, etc. Others may be missing some pieces of information. Found a macro (below) that described my same scenario but it's not working (run-time error 1004) and when I debug it appears to be getting hung up at "Cells(strt, 1).Resize(nd - strt).Copy". Help?

Sub Paste_Transpose()
Dim LastRow As Long, x As Long
Dim PasteRow As Long
Dim strt As Long, nd As Long
LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
PasteRow = 1
For x = 1 To LastRow + 1
If Len(Cells(x, 1)) = 0 And strt = 0 And nd = 0 Then
strt = Cells(x, 1).Row + 1
Else
If strt > 0 And Len(Cells(x, 1)) = 0 Then
nd = Cells(x, 1).Row
'paste transpose
Cells(strt, 1).Resize(nd - strt).Copy
Cells(PasteRow, 2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
strt = 0
nd = 0
x = x - 1
PasteRow = PasteRow + 1
End If
End If
Next
Application.CutCopyMode = False
'Columns(1).Delete
End Sub

 

[DanteAmor]

Hi and welcome to the board!

Try this

Sub Paste_Transpose_1()
  Dim c As Range
  For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
    Range("B" & Rows.Count).End(xlUp)(2).Resize(1, c.Rows.Count).Value = Application.Transpose(c.Value)
  Next
End Sub

 

[chzhd4life]

Oh my gosh Dante, that's amazing! A few quirks, like whenever there's ONE blank row in a grouping of data, it starts a new row instead of doing so only after TWO blank rows, but seriously saves me a ton of time! Is there a way to edit so it starts new row of table ONLY after TWO blank rows?

 

[DanteAmor]

A few quirks, like whenever there's ONE blank row in a grouping of data, it starts a new row instead of doing so only after TWO blank rows, but seriously saves me a ton of time! Is there a way to edit so it starts new row of table ONLY after TWO blank rows?

I did not understand what you need.
According to your image, the data is every 2 rows blank, and the macro works for that.
In fact it doesn't matter if there is a separation of a row or two or more.

 

[chzhd4life]

Here's an example of what it's doing in my most current example … I was thinking that because there's a blank between Prairie City OR and the phone number, it thinks it should start a NEW record with the phone number, when in fact everything up through the URL is one record and the new entry shouldn't start until after the TWO blank rows because all data up to the two blank rows is one record.

Data in left yellow column A is the original, data in columns B-H is what the macro did. Three entries starting in row with phone number belong to the record above it.

Don't get me wrong, it's AWESOME and I can happily make the occasional edits, just wondered if there was a way to easily modify the macro when I had a scenario like this. THANKS!!!

 

[Peter_SSs]

Welcome to the MrExcel board!

Give this a try. I have assumed that data starts in A2 & results to start at B2. If different, the code edit should be obvious enough.

Sub Rearrange()
  Dim a As Variant, b As Variant
  Dim i As Long, r As Long, c As Long, maxcol As Long
  
  a = Range("A2", Range("A" & Rows.Count).End(xlUp).Offset(2)).Value
  ReDim b(1 To UBound(a), 1 To Columns.Count)
  r = 1
  For i = 1 To UBound(a) - 2
    If Len(a(i, 1) & a(i + 1, 1)) = 0 And c > 0 Then
      r = r + 1
      c = 0
    ElseIf Len(a(i, 1)) > 0 Then
      c = c + 1
      If c > maxcol Then maxcol = c
      b(r, c) = a(i, 1)
    End If
  Next i
  Range("B2").Resize(r, maxcol).Value = b
End Sub

 

[chzhd4life]

Got this when I tried it? When I hit Debug, this was highlighted: Range("B2").Resize(r, maxcol).Value = b

 

[Peter_SSs]

If you Debug and hover over "r" and then over "maxcol" what do you see?

How big (rows) is your data?

Perhaps those blank cells are not actually blank? What happens if you put this formula in your sheet =CODE(A12) where A12 is one of the 'blank' cells.

Select all the column A data area then press F5 -> Special -> Constants -> OK
Have a look down and see if any of the 'blank' cells have been selected by the above process

 

[chzhd4life]

This particular one is 6700 rows.
r=750
I did the F5 thing, doesn't appear to have selected any of the blank cells.

 

[Peter_SSs]

..

then over "maxcol" what do you see?