Is it possible to move one row to multiple columns?

C

cloobless

Board Regular
Joined
Jul 15, 2014
Messages
84
Office Version
  1. 2010
Platform
  1. Windows
Hi, I've been trying to get a solution for what I thought would be simple. I have a very large flat text file of thousands of records. It's all in a single linear format with line breaks for each line of data. The data is grouped in thousands of groups in exactly the same way. I'm trying to automatically parse the data so that each group is parsed into separate columns. The data in the flat file looks like the following (except there are thousands of groups, not three...):

{note that the first three lines are always the same and there is never a change in their frequency}
{note that the "sender" lines are variable; sometimes there's none, sometimes five senders, sometimes two, etc.}
{note the line break after the final sender and the next set of data}

---
Existing:

DATEdata
SUBJECTdata
Locationdata
sender--1
sender--2
sender--3

DATEdata
SUBJECTdata
Locationdata
sender--1
sender--2
sender--3
sender--4

DATEdata
SUBJECTdata
Locationdata
sender--1


Possible?

[TABLE="width: 500"]
<tbody>[TR]
[TD]Date[/TD]
[TD]Subject[/TD]
[TD]Location[/TD]
[TD]Sender[/TD]
[/TR]
[TR]
[TD]2010-11-05[/TD]
[TD]recess[/TD]
[TD]c:[/TD]
[TD]sender--1[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]sender--2[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]sender--3[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2010-11-06[/TD]
[TD]oranges[/TD]
[TD]c:\\oranges[/TD]
[TD]sender--1[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]sender--2[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]sender--3[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]sender--4[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2010-11-08[/TD]
[TD]karate[/TD]
[TD]d:[/TD]
[TD]sender--1[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD](next)[/TD]
[TD](next)[/TD]
[TD](next)[/TD]
[TD](next)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD](next)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD](next)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD](next)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD](next)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD](next)[/TD]
[TD](next)[/TD]
[TD](next)[/TD]
[TD](next)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD](next)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD](next)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:
Sort by date Sort by votes
Hello cloobless,

You're welcome. I know time differences can make it difficult to respond quickly and life happens along the way too. So not a problem. When you get time, let me know how the macro runs for you.

You are correct about my background. I have been programming for a long time. This year marks my forty second year as a programmer. So how many computer languages? I have lost count. Human languages: English, Spanish, Latin, Japanese, and currently learning Scottish Gaelic.
 
Upvote 0

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Hello, Leith. Thank you so much. I'm testing the script and have an error 91 "object variable or with block variable not set" and then the debugger highlights the "Intersect(Wks.UsedRange, Wks.UsedRange.Offset(1, 0)).ClearContents" line.

In an attempt to teach myself, I looked into the error code and also double-checked the basics: the book is saved as .xlsm; I have named the headers the same as the examples above (Date, Subject, Location, Sender). I checked the text file to make sure it's ok -- I think it is; it's saved as .txt. I invoked and ran. I'm sure I made an error somewhere -- any idea of what might be happening?

42 years -- that is extremely impressive. Just curious -- in your years of programming, is there any one project that stands out?
 
Upvote 0
Hello clobless,

Sometimes computers are picky about qualifying objects. Try this...
Rich (BB code): 
    Application.Intersect(Wks.UsedRange, Wks.UsedRange.Offset(1, 0)).ClearContents
 
Upvote 0
Hi, Leith. I get the same error if I replace

Intersect(Wks.UsedRange, Wks.UsedRange.Offset(1, 0)).ClearContents
with
Application.Intersect(Wks.UsedRange, Wks.UsedRange.Offset(1, 0)).ClearContents

was that the right thing to do?
 
Upvote 0
Hello Cloobless,

Can you either post a copy of the workbook or email me a copy?
 
Upvote 0
Sure, do you mean just the excel file where I set up the macro? Or do you mean the text file/data? For the latter I would need to truncate it and take out some sensitive data, but I could do it no problem.
 
Upvote 0
Hello cloobless,

Both files would be preferable. You don't have to send the whole text file. Shorten it to say about 5 groups. That would be fine.
 
Upvote 0
Hi, Leith -- where can I email you? Does this forum support personal messages?
 
Upvote 0
Hello cloobless,

This forum has private messaging. Click on the person's name in the post and then click Private Message. I will send my email address to by private message.
 
Upvote 0
Hello Cloobless,

The problem was my workbook I used for development for some reason did error like yours. Although mine should have. The fix was easy.

The line of code causes the error when there is no data below row 1. If there is no range of cells to clear then the special object Nothing is returned. If you try to clear Nothing then you get the error.

Here is the updated code:
\
Rich (BB code): 
Sub ImportTextFile()


    Dim cnt         As Long
    Dim DataIn()    As Byte
    Dim DataOut     As Variant
    Dim Filename    As String
    Dim Lines       As Variant
    Dim n           As Long
    Dim Rng         As Range
    Dim Text        As String
    Dim Wks         As Worksheet
    
        Set Wks = ThisWorkbook.ActiveSheet
        
        Set Rng = Wks.Range("A2:D2")
        
        Filename = Application.GetOpenFilename("Text Files,*.txt")
        If Filename = "False" Then Exit Sub
        
            ' If there is no data in row 2 then the Intersect method returns Nothing. Clearing Nothing creates the error.
            On Error Resume Next
                Application.Intersect(Wks.UsedRange, Wks.UsedRange.Offset(1, 0)).ClearContents
            On Error GoTo 0
            
            Open Filename For Binary Access Read As #1 
                ReDim DataIn(LOF(1))
                Get #1 , , DataIn
            Close #1 
            
            Text = StrConv(DataIn, vbUnicode)
            
            Lines = Split(Text, vbCrLf)
            
                ReDim DataOut(1 To 4, 1 To 1)
            
                For cnt = 0 To UBound(Lines) - 1
                    If Lines(cnt) = "" Then
                        n = 0
                        Rng.Resize(UBound(DataOut, 2), UBound(DataOut, 1)).Value = Application.Transpose(DataOut)
                        Set Rng = Rng.Offset(UBound(DataOut, 2), 0)
                        ReDim DataOut(1 To 4, 1 To 1)
                    Else
                        n = n + 1
                        ReDim Preserve DataOut(1 To 4, 1 To n)
                        If n = 1 Then
                            DataOut(1, 1) = Lines(cnt)
                            DataOut(2, 1) = Lines(cnt + 1)
                            DataOut(3, 1) = Lines(cnt + 2)
                            cnt = cnt + 3
                        End If
                        DataOut(4, n) = Lines(cnt)
                    End If
                Next cnt
            
            Rng.Resize(UBound(DataOut, 2), UBound(DataOut, 1)).Value = Application.Transpose(DataOut)
            Set Rng = Rng.Offset(UBound(DataOut, 2), 0)
            
        Wks.Columns("A:D").AutoFit
            




End Sub
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

Kellie220
  • Question Question
VBA to Collapse Rows (3 part question)
Replies
1
Views
283
Artik
Artik
S
  • Question Question
VBA code for adding new group of columns with 3 condictions from 2 dictionary and 1 array Then fill in data from value from original columns
Replies
1
Views
128
sijpie
sijpie
Y
  • Question Question
Compare first 3 characters in two columns to find multiple matchings
Replies
3
Views
1K
DanteAmor
DanteAmor
S
  • Question Question
Accumulate Data from 10k+ Files. Very Slow. Issue with ActiveWorkbook.Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
2
Replies
10
Views
1K
NdNoviceHlp
NdNoviceHlp
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
1K
AndyEd
A

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top