VBA code for Grouping columns in excel based on certain criteria

priya2685

New Member
Joined
Oct 30, 2014
Messages
2
I need help with VBA to group columns on the basis of criteria in Row 13. If row 13 contains the word "Result" then columns will be grouped.

The Columns shows the Category first & then all the sub categories and I want to show the categories only.
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
I need help with VBA to group columns on the basis of criteria in Row 13. If row 13 contains the word "Result" then columns will be grouped.

The Columns shows the Category first & then all the sub categories and I want to show the categories only.

. If you then need specific help in your example then you will need to give more detail:-

. As always, “A (Good!) Picture paints a thousand words”

. . Can you Try to provide Tables that can be copied into a spreadsheet showing example data but also importantly exactly how the final output should look like in the Excel File based on your actual example data.


. There are various ways to do this. The first is preferred by this Forum for excel files as then everyone can see wot is going on quickly.. The Third method I prefer. - Then one can get on straight away with writing a code for you in the file you provide.

. 1 If you can, try uploading this, https://onedrive.live.com/?cid=8cffd...CE27E813%21189 instructions here MrExcel HTML Maker . This free Excel add-In is good for screen shots here of spreadsheets. Then everyone can quickly see what is going on and follow the Thread easily.
Or
. 2 Up left in the Thread editor is a table icon. Click that, create an appropriately sized table and fill it in. (To get this icon up in the Reply window you may need to click on the “Go Advanced” Button next to the Reply Button)
Or
. 3 Supply us with example Excel files (Can of course be shortened, or made - up data in case any info is sensitive)
. For example send over this free thing: Box Net,
Remember to select Share after uploading and give us the link they provide.

…………………..

. If you do that there is more chance of someone picking up the thread. If having done that no one picks it up then I will try to take a look at it later tomorrow.


Alan.
 
Upvote 0
Thanks for the response. The HTML add-in was quite useful. Here are some screenshots which might help explaining the exact requirement.Also I have uploaded the files here

https://www.dropbox.com/s/1uwj4hunu5xoh87/Mr Excel - VBA Query.xlsx?dl=0

[B]Excel 2010[/B][TABLE]
<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><thead>[TR="bgcolor: #DAE7F5"]
[TH][/TH]
[TH]A[/TH]
[TH]B[/TH]
[TH]C[/TH]
[TH]D[/TH]
[TH]E[/TH]
[TH]F[/TH]
[TH]G[/TH]
[TH]H[/TH]
[TH]I[/TH]
[TH]J[/TH]
[TH]K[/TH]
[TH]L[/TH]
[/TR]
</thead><tbody>[TR]
[TD="align: center"]1[/TD]
[TD]Category 1[/TD]
[TD]Category 1[/TD]
[TD]Category 1[/TD]
[TD]Category 1[/TD]
[TD]Category 1[/TD]
[TD]Category 1[/TD]
[TD]Category 1[/TD]
[TD]Category 1[/TD]
[TD]Category 1[/TD]
[TD]Category 1[/TD]
[TD]Category 1[/TD]
[TD]Category 1[/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD]Result[/TD]
[TD]Result[/TD]
[TD]Category 1.1[/TD]
[TD]Category 1.1[/TD]
[TD]Category 1.1[/TD]
[TD]Category 1.1[/TD]
[TD]Category 1.1[/TD]
[TD]Category 1.1[/TD]
[TD]Category 1.1[/TD]
[TD]Category 1.1[/TD]
[TD]Category 1.1[/TD]
[TD]Category 1.1[/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD]Result[/TD]
[TD]Result[/TD]
[TD]Category 1.1.1[/TD]
[TD]Category 1.1.1[/TD]
[TD]Category 1.1.1[/TD]
[TD]Category 1.1.1[/TD]
[TD]Category 1.1.1[/TD]
[TD]Category 1.1.1[/TD]
[TD]Category 1.1.1[/TD]
[TD]Category 1.1.1[/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD]Result[/TD]
[TD]Result[/TD]
[TD]Category 1.1.1.1[/TD]
[TD]Category 1.1.1.1[/TD]
[TD]Category 1.1.1.1[/TD]
[TD]Category 1.1.1.1[/TD]
[TD]Category 1.1.1.1[/TD]
[TD]Category 1.1.1.1[/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD]Result[/TD]
[TD]Result[/TD]
[TD]Category 1.1.1.1.1[/TD]
[TD]Category 1.1.1.1.1[/TD]
[TD]Category 1.1.1.1.1[/TD]
[TD]Category 1.1.1.1.1[/TD]
[/TR]
[TR]
[TD="align: center"]6[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD]Result[/TD]
[TD]Result[/TD]
[TD]Category 1.1.1.1.1.1[/TD]
[TD]Category 1.1.1.1.1.1[/TD]
[/TR]
[TR]
[TD="align: center"]7[/TD]
[TD]CY[/TD]
[TD]LY[/TD]
[TD]CY[/TD]
[TD]LY[/TD]
[TD]CY[/TD]
[TD]LY[/TD]
[TD]CY[/TD]
[TD]LY[/TD]
[TD]CY[/TD]
[TD]LY[/TD]
[TD]CY[/TD]
[TD]LY[/TD]
[/TR]
</tbody>[/TABLE]
[CENTER][COLOR=#161120][B]Raw Data[/B][/COLOR][/CENTER]

[B]Excel 2010[/B][TABLE]
<colgroup><col><col><col><col><col><col><col></colgroup><thead>[TR="bgcolor: #DAE7F5"]
[TH][/TH]
[TH]A[/TH]
[TH]B[/TH]
[TH]C[/TH]
[TH]D[/TH]
[TH]M[/TH]
[TH]N[/TH]
[/TR]
</thead><tbody>[TR]
[TD="align: center"]1[/TD]
[TD]Category 1[/TD]
[TD]Category 1[/TD]
[TD]Category 1[/TD]
[TD]Category 1[/TD]
[TD]Category 1[/TD]
[TD]Category 1[/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD]Result[/TD]
[TD]Result[/TD]
[TD]Category 1.1[/TD]
[TD]Category 1.1[/TD]
[TD]Category 1.2[/TD]
[TD]Category 1.2[/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD]Result[/TD]
[TD]Result[/TD]
[TD]Result[/TD]
[TD]Result[/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]6[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]7[/TD]
[TD]CY[/TD]
[TD]LY[/TD]
[TD]CY[/TD]
[TD]LY[/TD]
[TD]CY[/TD]
[TD]LY[/TD]
[/TR]
</tbody>[/TABLE]
[CENTER][COLOR=#161120][B]Result Needed[/B][/COLOR][/CENTER]

 
Upvote 0
Hi,
Thanks for the response. The HTML add-in was quite useful. Here are some screenshots which might help explaining the exact requirement. Also I have uploaded the files here
………..

…….
. 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.

. O.K. I have a working solution for you. Bear in mind I am a VBA beginner practicing by answering these sort of Threads. My methods are therefore somewot primitive, so hopefully a pro will also give a better solution which we will then both benefit from!
. Before I start - I had one “Spanner in the works” which I do not understand: Many of your words like Result came out in my Excel (2007) like ‘Result. That strange apostrophe at the start seemed to confuse VBA and was not always recognized giving erroneous results. I have seen this sort of thing before but I do not understand it. For now I simply removed those in the file I am returning to you. So check that they have not “re appeared”
. For the file I return to you the only things of interest are sheet 1 and sheets 2 and the macros in the module called priya2685.
. In that file an extract from sheet 1 looks something like this before running any macros (In other words empty)


Book1
ABCDEFG
1
2
3
4
5
6
7
8
Results

. In sheet 2 is your raw data as you supplied, but with some of those apostrophes removed
. After running either of the Macros I have written for you, sheet 1 will look like this, which I believe is wot you wanted. The HTML Maker may make that grey too dark for you to see everthing clearly but I assure you it looks in the uploaded file the same as your results needed!!


Book1
ABCDOPY
1Category 1Category 1Category 1Category 1Category 1Category 1
2ResultResultCategory 1.1Category 1.1Category 1.2Category 1.2
3ResultResultResultResult
4
5
6
7CYLYCYLYCYLY
8
Results

The relavent macros are in that module called priya2685.
. For the beneft of others viewing or considering improving (please!!) my beginner’s attempt here are those codes
Code:
[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]

Code:
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

. If you are new to macros and VBA, and need help in getting started or have any further questions then get back and I will try to look in later. Most important: save a back up copy of this File BEFORE running any macro, as you cannot reverse changes done with a macro in the usual way that you can with anything you do manually in a spreadsheet!
. Please let me know anyway how you get on.
Here is your returned file with all the above in. Same name but with the necerssary .xlsm rather than .xlsx extension as necerssary for a file with macros in it.
https://app.box.com/s/yaid7zntz98e021jqgjs

Alan
Bavaria
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

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