Repost with correction on turn report data into list

[MarkN]

I regularly get sent a report that needs modifying to make it into a list so
that it can be analysed. I have found and used or recorded macros to get rid
of some of the problems but the final formatting is beyond me because I'm
more of an interested amateur than a pro.

The problem is that each record is on multiple rows and I need to get them
all onto single rows.

The format for each record is:
Header1, Header1, Header1
DetailsA, DetailsA, DetailsA, DetailsA, DetailsA
DetailsB, DetailsB, DetailsB, DetailsB, DetailsB
Header2, Header2, Header2
DetailsA, DetailsA, DetailsA, DetailsA, DetailsA
DetailsB, DetailsB, DetailsB, DetailsB, DetailsB
DetailsC, DetailsC, DetailsC, DetailsC, DetailsC

The is only ever one header row but there are any number of details rows.

I would like to get to:

Header1, Header1, Header1, DetailsA, DetailsA, DetailsA, DetailsA, DetailsA
Header1, Header1, Header1, DetailsB, DetailsB, DetailsB, DetailsB, DetailsB
Header2, Header2, Header2, DetailsA, DetailsA, DetailsA, DetailsA, DetailsA
Header2, Header2, Header2, DetailsB, DetailsB, DetailsB, DetailsB, DetailsB
Header2, Header2, Header2, DetailsC, DetailsC, DetailsC, DetailsC, DetailsC

I hope this makes sense and thanks in advance for any suggestions.

Cheers,
Mark

 

[joel]

I need two questions answered

1) Is there any blank rows in you data seperating the differet block
of data (each block a new header row)
2) How can you tell a header row from a data row? Are hear rows wit
any key words. Is the Data rows number and header rwos text. Do heade
rows have 3 columns and data rows 5 columns

 

[MarkN]

Thanks for the reply. To answer your questions:

1) There are no blank rows at all in the entire block of data.
2) The header rows are always bold. The details rows always begin with
d/mm/yyyy in column A. Yes, header uses three columns and details row uses
five columns.

Cheers,
Mark

 

[joel]

This should work

Sub ReadData()
'
Set DestSht = Sheets("sheet1")

'
fileToOPen = Application _
.GetOpenFilename("Text Files (*.txt), *.txt")
If fileToOPen = False Then
MsgBox ("Cannot OPen file - Exiting Macro")
Exit Sub
End If

Workbooks.OpenText Filename:=fileToOPen, _
DataType:=xlDelimited, Comma:=True
Set bk = ActiveWorkbook

Set SourceSht = bk.Sheets(1)

NewRowCount = 1
With SourceSht
OldRowCount = 1
Do While .Range("A" & OldRowCount) <> ""
LastCol = .Cells(OldRowCount
Columns.Count).End(xlToLeft).Column
If LastCol = 3 Then
ColAHeader = .Range("A" & OldRowCount)
ColBHeader = .Range("B" & OldRowCount)
ColCHeader = .Range("C" & OldRowCount)
Else
Set CopyRange = _
.Range("A" & OldRowCount & ":E" & OldRowCount)
With DestSht
.Range("A" & NewRowCount) = ColAHeader
.Range("B" & NewRowCount) = ColBHeader
.Range("C" & NewRowCount) = ColCHeader
CopyRange.Copy _
Destination:=.Range("D" & NewRowCount)
NewRowCount = NewRowCount + 1
End With
End If
OldRowCount = OldRowCount + 1
Loop

End With


bk.Close savechanges:=fales


End Su

 

[MarkN]

Thanks for your efforts Joel, that works superbly.