How do I take a single column of data and create multiple columns by keyword?

Posted on 2011-09-14
Last Modified: 2012-05-12
I have a text file that I import into Excel that shows the revision changes of a part number.  The data is stored as one column and each revision section has a title.  I need to compare the changes between revisions and I would like to see each revision side by side.  Attached is a simple sample of what I am trying to accomplish.  The first sheet shows the original data, the second sheet shows how I want it.
Question by:zepold
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
LVL 24

Accepted Solution

StephenJR earned 500 total points
ID: 36539529
Try this:
Sub x()
Dim rFind As Range, rFind2 As Range, sFind As String, sAddr As String

With Sheets("Original").Columns(1)
    Set rFind = .Find(What:="NEW REVISION", After:=.Cells(.Rows.Count), LookAt:=xlWhole, _
                      MatchCase:=False, SearchFormat:=False)
    If Not rFind Is Nothing Then
        sAddr = rFind.Address
            Set rFind2 = .FindNext(rFind)
            If rFind2.Row < rFind.Row Then
                Range(rFind, .Cells(.Rows.Count)).Copy Sheets("Modified").Cells(1, Columns.Count).End(xlToLeft).Offset(, 1)
                Range(rFind, rFind2.Offset(-1)).Copy Sheets("Modified").Cells(1, Columns.Count).End(xlToLeft).Offset(, 1)
            End If
            Set rFind = rFind2
         Loop While rFind.Address <> sAddr
    End If
End With
End Sub

Open in new window

LVL 24

Expert Comment

ID: 36539534
That assumes your heading is "NEW REVISION" but just occurred that may not be the case, in which case will need revisiting.
LVL 24

Expert Comment

ID: 36539648
Perhaps if the only distinguishing feature is the case:
Sub x()
Dim r As Range, r1 As Range, r2 As Range, c As Long

Set r = Sheets("Original").Range("A1")

Do Until IsEmpty(r)
    Do Until r.Value = UCase(r.Value)
        Set r = r.Offset(1)
    Set r1 = r
    Set r = r.Offset(1)
    Do Until r.Value = UCase(r.Value)
        Set r = r.Offset(1)
    Set r2 = r.Offset(-1)
    c = c + 1
    Range(r1, r2).Copy Sheets("Modified").Cells(1, c)
    Set r = r2.Offset(1)
End Sub

Open in new window


Author Closing Comment

ID: 36543033
This script worked perfectly.

Thank you very much,


Featured Post

Salesforce Has Never Been Easier

Improve and reinforce salesforce training & adoption using WalkMe's digital adoption platform. Start saving on costly employee training by creating fast intuitive Walk-Thrus for Salesforce. Claim your Free Account Now

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

729 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question