. Thanks for the extra info. It makes things a lot easier. Glad you are using the HTML Maker, then everyone can see easily wot is going on.
| Book1 | |||||||||
|---|---|---|---|---|---|---|---|---|---|
| A | B | C | D | E | F | G | |||
| 1 | |||||||||
| 2 | |||||||||
| 3 | |||||||||
| 4 | |||||||||
| 5 | |||||||||
| 6 | |||||||||
| 7 | |||||||||
| 8 | |||||||||
Results | |||||||||
| Book1 | |||||||||
|---|---|---|---|---|---|---|---|---|---|
| A | B | C | D | O | P | Y | |||
| 1 | Category 1 | Category 1 | Category 1 | Category 1 | Category 1 | Category 1 | |||
| 2 | Result | Result | Category 1.1 | Category 1.1 | Category 1.2 | Category 1.2 | |||
| 3 | Result | Result | Result | Result | |||||
| 4 | |||||||||
| 5 | |||||||||
| 6 | |||||||||
| 7 | CY | LY | CY | LY | CY | LY | |||
| 8 | |||||||||
Results | |||||||||
[color=green]'Option Explicit[/color]
[color=darkblue]Sub[/color] ColumnsGrouped()
[color=darkblue]Dim[/color] wks1 [color=darkblue]As[/color] Worksheet, wks2 [color=darkblue]As[/color] Worksheet [color=green]' Give name and all properties and methods of object Worksheet to these[/color]
[color=darkblue]Set[/color] wks1 = Worksheets.Item(1) [color=green]'First work sheet (results needed)[/color]
[color=darkblue]Set[/color] wks2 = Worksheets.Item(2) [color=green]'Scond worksheet (Raw data)[/color]
wks2.Cells.Copy Destination:=wks1.Cells
[color=darkblue]Dim[/color] UsedClms [color=darkblue]As[/color] [color=darkblue]Long[/color], Clms [color=darkblue]As[/color] [color=darkblue]Long[/color] [color=green]' Number of columns you have, Columns Count for looping[/color]
[color=darkblue]Let[/color] UsedClms = Cells.Find(What:="*", After:=Cells(1, 1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column [color=green]' work backwards from first cell(effectively start at last cell) to find anything and pick out last Column from that rereturned Range Object[/color]
[color=darkblue]Dim[/color] strtClm [color=darkblue]As[/color] [color=darkblue]Long[/color] [color=green]'The first column where you start grouping[/color]
[color=darkblue]Let[/color] strtClm = Cells.Find(What:="*", After:=Cells(3, 1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlNext).Column [color=green]' work forwards from first cell in row 3 to find anything and pick out last Column from that rereturned Range Object[/color]
[color=darkblue]Dim[/color] NoToGroup [color=darkblue]As[/color] [color=darkblue]Long[/color] [color=green]' Number of Columns to be grouped.[/color]
[color=darkblue]Dim[/color] Flag [color=darkblue]As[/color] [color=darkblue]Boolean[/color] [color=green]'Flag to indicate if we are counting Columns to be grouped[/color]
[color=darkblue]Let[/color] Flag = [color=darkblue]False[/color] [color=green]' we have no colums to group initially[/color]
[color=darkblue]For[/color] Clms = strtClm [color=darkblue]To[/color] UsedClms + 1 [color=darkblue]Step[/color] 1
[color=darkblue]If[/color] Cells(3, Clms).Value <> "Result" [color=darkblue]Then[/color]
[color=darkblue]Let[/color] Flag = [color=darkblue]True[/color] [color=green]'We need to count columns to be grouped[/color]
[color=darkblue]Let[/color] NoToGroup = NoToGroup + 1 [color=green]' For each non Result in Row 3 we count how many columns to group.[/color]
[color=darkblue]Else[/color]
[color=darkblue]Let[/color] Flag = [color=darkblue]False[/color] [color=green]' We are not counting columns to group[/color]
[color=darkblue]End[/color] [color=darkblue]If[/color]
[color=darkblue]If[/color] Flag = [color=darkblue]False[/color] And NoToGroup <> 0 [color=darkblue]Then[/color] [color=green]'We have Columns to group, but have just hit a Result.[/color]
Range(Cells(1, Clms - NoToGroup), Cells(1, Clms - 1)).EntireColumn.Group
[color=darkblue]Let[/color] NoToGroup = 0 [color=green]' We are finished with the current grouping.[/color]
[color=darkblue]ElseIf[/color] Flag = [color=darkblue]True[/color] And NoToGroup <> 0 And Clms = UsedClms [color=darkblue]Then[/color] [color=green]'This is the situation if we are counting columns to group bue have hit the end of the file[/color]
Range(Cells(1, Clms - NoToGroup + 1), Cells(1, Clms - 1 + 1)).EntireColumn.Group
[color=darkblue]Else[/color] [color=green]'We are either grouping or looking for next column to Group, so it is not time to take any action.[/color]
[color=darkblue]End[/color] [color=darkblue]If[/color]
[color=darkblue]Next[/color] Clms [color=green]'Start again to see if next column has Result in row 3[/color]
wks1.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1 [color=green]'Hide Grouped Columns.[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color] [color=green]'ColumnsGrouped()[/color]Sub ColumnsGroupedSimplified()
Dim wks1 As Worksheet, wks2 As Worksheet
Set wks1 = Worksheets.Item(1)
Set wks2 = Worksheets.Item(2)
wks2.Cells.Copy Destination:=wks1.Cells
Let UsedClms = Cells.Find(What:="*", After:=Cells(1, 1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column
Let strtClm = Cells.Find(What:="*", After:=Cells(3, 1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlNext).Column
Let Flag = False
For Clms = strtClm To UsedClms + 1 Step 1
If Cells(3, Clms).Value <> "Result" Then
Let Flag = True
Let NoToGroup = NoToGroup + 1
Else
Let Flag = False
End If
If Flag = False And NoToGroup <> 0 Then
Range(Cells(1, Clms - NoToGroup), Cells(1, Clms - 1)).EntireColumn.Group
Let NoToGroup = 0
ElseIf Flag = True And NoToGroup <> 0 And Clms = UsedClms Then
Range(Cells(1, Clms - NoToGroup + 1), Cells(1, Clms - 1 + 1)).EntireColumn.Group
Else
End If
Next Clms
wks1.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
End Sub
