Actually, I really wanted this line:

RngToCopy.Copy
NewWks.Cells(oRow, oCol).PasteSpecial

to be:

RngToCopy.Copy _
destination:=NewWks.Cells(oRow, oCol)

But in this case, there really isn't a difference.



StumpedAgain wrote:

You are the man. Still don't know what was wrong with mine but meh... yours
works just fine! Thanks!!!

"Dave Peterson" wrote:

You really have those "date:", "Name:", "Shift:" headers?

And empty cells between each of those groupings????

And those values in the cells are just plain old text--not formulas????

This just looks for the "Date:" in column A and then bases every group on that.
It does expect exactly 2 categories per group.

Option Explicit
Sub testme()

Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim FirstRow As Long
Dim oRow As Long
Dim BigRng As Range
Dim SmallArea As Range
Dim NextGroupMustBeFirstCategory As Boolean
Dim RngToCopy As Range
Dim oCol As Long
Dim LinesPerGroup As Long

Set CurWks = Worksheets("Sheet1")
Set NewWks = Worksheets.Add

With CurWks
FirstRow = 1
Set BigRng = .Range(.Cells(FirstRow, "A"), _
.Cells(.Rows.Count, "A").End(xlUp)) _
.Cells.SpecialCells(xlCellTypeConstants)
oRow = 0
LinesPerGroup = 1
For Each SmallArea In BigRng.Areas
If LCase(SmallArea.Cells(1, 1).Value) Like LCase("Date:*") Then
'This is the Date/name/shift group
'Start of a new group.
oRow = oRow + LinesPerGroup
NewWks.Cells(oRow, "A").Resize(1, 5).Value _
= Array("Date", "Name", "Shift", "Category A", "Category B")

oRow = oRow + 1
'remove "Date: "
NewWks.Cells(oRow, "A").Value _
= Trim(Mid(SmallArea.Cells(1, 1).Value, 6))

'remove "Name: "
NewWks.Cells(oRow, "B").Value _
= Trim(Mid(SmallArea.Cells(2, 1).Value, 6))

'remove "Shift: "
NewWks.Cells(oRow, "C").Value _
= Trim(Mid(SmallArea.Cells(3, 1).Value, 7))

NextGroupMustBeFirstCategory = True
LinesPerGroup = 3
Else
'This is the category A or Category B section.
With SmallArea
If .Cells.Count LinesPerGroup Then
LinesPerGroup = .Cells.Count
End If
Set RngToCopy = .Resize(.Rows.Count - 1, 1).Offset(1, 0)
End With
If NextGroupMustBeFirstCategory Then
oCol = 4 'column D
'get ready for the category B group
NextGroupMustBeFirstCategory = False
Else
oCol = 5 'column E
End If

RngToCopy.Copy
NewWks.Cells(oRow, oCol).PasteSpecial

End If
Next SmallArea

End With

Application.CutCopyMode = False
NewWks.UsedRange.Columns.AutoFit

End Sub




StumpedAgain wrote:

Sure. Sorry for the confusion.

What I have:

Date: 123
Name: 456
Shift: 789

Category A
line 1
line 2
line 3
line 4
line 5

Category B
line 1
line 2
line 3
line 4
line 5
line 6

Date: 123
Name: 456
Shift: 789

Category A
line 1
line 2
line 3
line 4
line 5

Category B
line 1
line 2
line 3
line 4
line 5
line 6

etc.

What I want:

Date Name Shift Category A Category B
123 456 789 line 1 line 1
line 2 line 2
line 3 line 3
line 4 line 4
line 5 line 5
line 6
Date Name Shift Category A Category B
345 678 123 line 1 line 1
line 2 line 2

etc.

Hopefully it doesn't wrap it weird. Hope this helps!

--

Dave Peterson


--

Dave Peterson