Range Select/Transpose Macro

[Christopher Hanna]

I want to make a macro/VBA script that will search a single column for separators (dashes), select the rows between the dashes and transpose that data into another worksheet. There are several hundred "records" laid out this way.

Ideally, I'd like the macro to find/select the next range and keep going to the bottom of the column. Possible?

 

[hiker95]

Christopher Hanna,

Welcome to the MrExcel forum.

What version of Excel and Windows are you using?

Can you post a screenshot of the actual raw data worksheet, and, post a screenshot of the worksheet results (manually formatted by you) that you are looking for?

To post your data, you can download and install one of the following two programs:
Excel Jeanie
MrExcel HTML Maker
Or, when using Internet Explorer, just put borders around your data in Excel and copy those cells into your post.
See reply #2 the BLUE text in the following link:
http://www.mrexcel.com/forum/about-board/444901-how-create-table-like-aladin.html#post2198045


If you are not able to give us screenshots:
You can upload your workbook to Box Net,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.

 

[Christopher Hanna]

At present, I only have test/sample data, but it's this times 400+ instances, so looking to take some of the manual copy/transpose+switch worksheets out of the process. Thanks.

---------------
Smith, John C.
President
Asst: Jim Jones
Phone: 123-456-7890
Fax: 123-456-7890
Email: jsmith@bizco.com
Biziness Company
One Tycoon Drive
Bigstown, ST 10101
Tag 1
Tag 2
Equities/Securities
Notes
---------------
Smith, Larry
President
Phone: 123-456-7890
Fax: 123-456-7890
Email: jsmith@bizco.com
Biziness Company
One Tycoon Drive
Bigstown, ST 10101
Tag 1
Equities/Securities
Notes
---------------
Jones, Fred
President
Phone: 123-456-7890
Fax: 123-456-7890
Email: jsmith@bizco.com
Biziness Company
One Tycoon Drive
Bigstown, ST 10101
Tag 1
Equities/Securities
Notes
---------------

 

[Rick Rothstein]

Give this macro a try...

Sub TransposeBetweenDashes()
  Dim Max As Long, Ar As Range, C As Range
  Columns("A").Replace "---------------", "", xlPart
  Set C = Columns("A").SpecialCells(xlConstants)
  If Not C Is Nothing Then
    For Each Ar In C.Areas
      Ar(1).Resize(, Ar.Count) = Application.Transpose(Ar)
      If Ar.Count > Max Then Max = Ar.Count
    Next
    Range("A1").Formula = "Header 1"
    Range("A1").AutoFill Destination:=Range("A1").Resize(, Max), Type:=xlFillDefault
    Range("B2:B" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlBlanks).EntireRow.Delete
  End If
End Sub

 

[Christopher Hanna]

Holy quick response and massive data transposition! Give this man the Iron Man brilliance award. Thank you!

Any way to put the transposed data in successive rows?

 

[Rick Rothstein]

Any way to put the transposed data in successive rows?

Did you mean "successive columns" (that is, line up like item under each other in their own row)? I don't think so. It would be so much easier to do if each line of data started with its own keyword followed by a colon (like "Phone:", "Email:", etc.), but some of your data does not have keywords and they might not be in each group of data (such as Tag1 and Tag2). Also, I do not know which non-keyword lines of data could possibly not appear (for instances, the business address before the Tag#)... with this possible variation, it is hard to have a program decide which non-keyworded lines of data belong to which category.

 

[Christopher Hanna]

Per my screenshot, I did mean successive rows. I know the data won't match any header layout, and that's OK for this step. As you've pointed out, the data doesn't have consistent keywords to do this. So I'll have to do more massaging.

I'll use arbitrary references here. I'm looking to transpose the data between dashes in column A1 to rows starting at B1.

 

[Rick Rothstein]

Per my screenshot, I did mean successive rows. I know the data won't match any header layout, and that's OK for this step. As you've pointed out, the data doesn't have consistent keywords to do this. So I'll have to do more massaging.

I'll use arbitrary references here. I'm looking to transpose the data between dashes in column A1 to rows starting at B1.

So my code did not do what you wanted? Let me see if I understand what you need then. You want the list my code produced to start in Column B and you want the original data to remain untouched... is that correct? If so...

Sub TransposeBetweenDashes()
  Dim Max As Long, Ar As Range, C As Range
  Columns("A").Replace "---------------", "", xlPart
  Set C = Columns("A").SpecialCells(xlConstants)
  If Not C Is Nothing Then
    For Each Ar In C.Areas
      Ar(1).Offset(, 1).Resize(, Ar.Count) = Application.Transpose(Ar)
      If Ar.Count > Max Then Max = Ar.Count
    Next
    Range("B1").Formula = "Header 1"
    Range("B1").AutoFill Destination:=Range("B1").Resize(, Max), Type:=xlFillDefault
    Intersect(Range("B1").Resize(, Max).EntireColumn, Range("B2:B" & Cells(Rows.Count, _
                "A").End(xlUp).Row).SpecialCells(xlBlanks).EntireRow).Delete xlShiftUp
  End If
End Sub

 

[Rick Rothstein]

So my code did not do what you wanted? Let me see if I understand what you need then. You want the list my code produced to start in Column B and you want the original data to remain untouched... is that correct? If so...

Sub TransposeBetweenDashes()
  Dim Max As Long, Ar As Range, C As Range
  Columns("A").Replace "---------------", "", xlPart
  Set C = Columns("A").SpecialCells(xlConstants)
  If Not C Is Nothing Then
    For Each Ar In C.Areas
      Ar(1).Offset(, 1).Resize(, Ar.Count) = Application.Transpose(Ar)
      If Ar.Count > Max Then Max = Ar.Count
    Next
    Range("B1").Formula = "Header 1"
    Range("B1").AutoFill Destination:=Range("B1").Resize(, Max), Type:=xlFillDefault
    Intersect(Range("B1").Resize(, Max).EntireColumn, Range("B2:B" & Cells(Rows.Count, _
                "A").End(xlUp).Row).SpecialCells(xlBlanks).EntireRow).Delete xlShiftUp
  End If
End Sub

Sorry, I forgot to put the 15 dashes back in between the data groups; use this code instead of the above code...

Sub TransposeBetweenDashes()
  Dim Max As Long, Ar As Range, C As Range
  Columns("A").Replace "---------------", "", xlPart
  Set C = Columns("A").SpecialCells(xlConstants)
  If Not C Is Nothing Then
    For Each Ar In C.Areas
      Ar(1).Offset(, 1).Resize(, Ar.Count) = Application.Transpose(Ar)
      If Ar.Count > Max Then Max = Ar.Count
    Next
    Range("B1").Formula = "Header 1"
    Range("B1").AutoFill Destination:=Range("B1").Resize(, Max), Type:=xlFillDefault
    Intersect(Range("B1").Resize(, Max).EntireColumn, Range("B2:B" & Cells(Rows.Count, _
                "A").End(xlUp).Row).SpecialCells(xlBlanks).EntireRow).Delete xlShiftUp
    Range("A1:A" & C.Count).SpecialCells(xlBlanks).Value = String(15, "-")
  End If
End Sub

 

[Christopher Hanna]

Not at all, sir. Your code worked admirably and brought to mind something I hadn't thought of prior: using the dashes to put records on separate rows! The revised code is doing is adding dashes in column A. Previously you mentioned lining up the data (impossible, no consistent header), but lining up the dashes (start of record) would be grand.