Solved

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

Posted on 2011-09-14
4
171 Views
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.
Sample-Data.xlsx
0
Comment
Question by:zepold
  • 3
4 Comments
 
LVL 24

Accepted Solution

by:
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
        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
 
LVL 24

Expert Comment

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

Expert Comment

by:StephenJR
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)
    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
 

Author Closing Comment

by:zepold
ID: 36543033
This script worked perfectly.

Thank you very much,

David
0

Featured Post

Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

828 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