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

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.
Sample-Data.xlsx
zepoldAsked:
Who is Participating?
 
StephenJRConnect With a Mentor Commented:
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
        Do
            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)
            Else
                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

0
 
StephenJRCommented:
That assumes your heading is "NEW REVISION" but just occurred that may not be the case, in which case will need revisiting.
0
 
StephenJRCommented:
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)
    Loop
    Set r1 = r
    Set r = r.Offset(1)
    
    Do Until r.Value = UCase(r.Value)
        Set r = r.Offset(1)
    Loop
    Set r2 = r.Offset(-1)
    
    c = c + 1
    Range(r1, r2).Copy Sheets("Modified").Cells(1, c)
    Set r = r2.Offset(1)
Loop
     
End Sub

Open in new window

0
 
zepoldAuthor Commented:
This script worked perfectly.

Thank you very much,

David
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.