VBA to format Imported Text Document

B

Btibert

Hi everyone,

Here is a problem that I cant seem to solve.

I am inputting data into Excel that comes from a text document. I ca
get the data into excel no problem of course, but I would like to se
if there is an easy solution to my problem.

When the data is placed into excel, I was hoping that I could run som
code that identifies "page breaks" from a certain point forward on m
master worksheet, and creates a new worksheet for each page of data
such that if my data contains 99 "breaks", then there would be 10
worksheets.

Simply put, each page break in my data is clearly defined as thre
empty rows between each other. I have been working through some code
unsuccessfully of course. Is it possible to place the data on a ne
sheet when the next break is found for each page break until my maste
worksheet has no more data.

Im not entirely sure that is possible, but I have learned that you ca
do more than you can imagine in VBA.

Any assistance will be greatly appreciated.

Best Wishes,

Broc
 
G

Greg Wilson

The following is my interpretation. It starts from the
active cell and continues to the end of the imported text.
It assumes that all the text is in Column A - i.e. the
text is NOT split up into separate columns. Also assumed
is that the desired page breaks are designated by three(3)
empty cells in a row in Column A. If these interpretations
are not correct then it is probably an easy fix.

Ensure that you have a copy of your data before executing.

Sub BreakData()
Dim wks As Worksheet, wks2 As Worksheet
Dim rng As Range, rng2 As Range
Dim c As Range, cc As Range
Dim x As Long, i As Long, ii As Long

Set wks2 = Sheets(Sheets.Count)
x = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range(ActiveCell, Cells(x, 1))
Set cc = rng(1)
i = 0: ii = 0: x = 0
For Each c In rng
ii = ii + 1
If Trim(c) = "" Then
i = i + 1
If i = 3 Then
Set rng2 = Range(cc, rng(ii))
Set cc = c(2)
x = x + 1
Set wks = Sheets.Add(After:=wks2)
wks.Name = "Page " & x
Set wks2 = wks
With wks
Range(.Cells(1, 1), .Cells(rng2.Count, 1)). _
Value = rng2.Value
End With
End If
Else
i = 0
End If
Next
End Sub

Regards,
Greg
 
G

Greg Wilson

Correction to my post:-

Change the line:
x = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
To:
x = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1

Also change the line:
If i = 3 Then
To:
If i = 3 Or ii = rng.Count Then

Doing what I do best: Screwing-up !!!

Regards,
Greg
 
B

Btibert

First let me open by thanking you for any time and effort that you put
into assisting me.

I do have two questions. When I run the code, i get a Run time Error
13 , and debug goes to the line in the code

If Trim(c) = "" Then

Im not sure why this occured.

Also, in your code, the way I have my code set up currently (coding
before this problem), is there any way your code can be created such
that the scan column k for three blank rows(or cells, however you want
to look at it) for the page break?

Your assumptions were correct, and scanning a column is fine. I just
hope that I can have it start the scan from range K5.

Again, I appreciate any assistance you can provide

Best wishes,

Brock
 
B

Btibert

Oh sorry, one more thing.

When the scan finds a set of three cells that are empty, which woul
signal a new page to be created, I was hoping that the new page woul
contain all of the data, not just the row.

Simply put, if the scan of column K found three rows, the range of dat
below it (for example if the new page was found to start on row 57, th
only range of data that would be placed on the new sheet would b
a57:z75, since three more blank rows started at row 76. This proces
would continue to place the entire range of data, not just the colum
data, for each page found until the end of the master data page i
scanned.

I know that is probably all over that map for a description, but I a
hoping that makes it more clear.

Thanks for everything,

Broc
 
G

Greg Wilson

Hi Brock,

Point 1:
My code assumed that you would select the desired cell in
column A where you wanted to start the operation. The
macro keys off of the active cell (selected cell). Did you
select this cell?

Point 2:
I tested the code with simple text values placed in column
A - e.g. "Text1" in cell A1, "Text2" in cell A2 etc. I
carried this down to about A30 ("Text30" in cell A30). I
then inserted empty cells at several locations within this
column of text values. These were mostly groups of three
empty cells although I also inserted examples of 1 and 2
empty cells in order to prove that the code wouldn't
create new pages unless a groups of three were found.

I then executed the code and confirmed that it created a
new page each time it found a group of 3 empty cells that
included the text from ALL cells (not just one) between
the current group of three empty cells and the preceeding
group.

Advised is that you test the code using this simple
example and see if it works.

Point 3:
I dont't know why you got an error with the code:
<<< If Trim(c) = "" Then >>>
I couldn't replicate it. In my knew version I include
error suppression although you should test the code
without it. To do so, remove the line:
<<< On Error Resume Next >>>

Point 4:
My new version of code is hard-coded to start at cell K5.
It searches for groups of three empty cells in column K
instead of column A. When found, it creates new pages that
include the contents of the entire rows (not just cells)
between the current group of three empty cells and the
preceeding group. The new code version follows. Hope we
are at least getting closer:-

Sub BreakData2()
Dim wks As Worksheet, wks2 As Worksheet
Dim rng As Range, rng2 As Range
Dim c As Range, cc As Range
Dim x As Long, i As Long, ii As Long
Dim AddPage As Boolean

On Error Resume Next
Set wks2 = Sheets(Sheets.Count)
x = Cells(Rows.Count, 11).End(xlUp).Row
Set rng = Range(Cells(5, 11), Cells(x, 11))
Set cc = rng(1)
i = 0: ii = 0: x = 0
For Each c In rng
ii = ii + 1
If Trim(c) = "" Then
i = i + 1
If i = 3 Then
Set rng2 = Range(cc, rng(ii - 3)).EntireRow
Set cc = c(2)
AddPage = True
End If
ElseIf ii = rng.Count Then
Set rng2 = Range(cc, rng(ii)).EntireRow
AddPage = True
Else
i = 0
AddPage = False
End If
If AddPage = True Then
x = x + 1
Set wks = Sheets.Add(After:=wks2)
wks.Name = "Page " & x
Set wks2 = wks
With wks
Range(.Cells(1, 1), .Cells(rng2.Count, 1)).EntireRow. _
Value = rng2.Value
End With
End If
Next
On Error GoTo 0
End Sub

Regards,
Greg
 
Top