Help Needed! Drop down list, Macro, Grouped rows

[Tingle]

Hi All,

I am having trouble trying to work out the following...

I have 3 groups of data (in rows of 10, grouped so that I can minimise).

Ideally what i need is a drop down list at the top of the page (3 options, Group 1, Group 2 & Group 3) so that when i select a group they reveal all 10 rows. I thought i would be able to do this with a simple Macro recording, but it appears not. After recording the macro and then trying to test it, it doesn't seem to open the grouped rows.

Can anyone help!

Thank you for your time

 

[L. Howard]

Hi Tingle, welcome to the board.

Do these steps and see if it is what you want. I will use Sheet 1 and 2, you can adjust if need.

On sheet 2, A1:C1 enter Group 1, Group 2, Group 3. (add your 10 items below each group, in rows 2 to 11)

On sheet 1 in cell B2 install a data validation drop down > Allow > List > Source > =Sheet2!$A$1:$C$1 > OK.

In cell C1 enter this formula =B2 & " List"

Copy and paste the code below into Sheet 1 code module.

Select a group from B2 drop down.

Howard

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("$B$2")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub

Dim rngFound As Range
Dim aRowCount As Long, _
    aColumn As Long, _
    tRowCount As Long, _
    tColumn As Long
Dim myFnd As String

myFnd = Target

Application.EnableEvents = False

    tColumn = Target.Offset(, 1).Column
  
   tRowCount = Cells(Rows.Count, tColumn).End(xlUp).Row
   
   If Target.Offset(, 1) Is Nothing Then
   '
     Else

     Target.Offset(, 1).Resize(tRowCount, 1).ClearContents

   End If
      
Set rngFound = Sheets("Sheet2").Range("A1:C1").Find(What:=myFnd, _
                                               LookIn:=xlValues, _
                                               LookAt:=xlWhole, _
                                               SearchOrder:=xlByRows, _
                                               SearchDirection:=xlNext, _
                                               MatchCase:=False)
                                               
If Not rngFound Is Nothing Then

   aColumn = rngFound.Column
   aRowCount = Sheets("Sheet2").Cells(Rows.Count, aColumn).End(xlUp).Row
   aColumn = rngFound.Column

  rngFound.Offset(1, 0).Resize(aRowCount).Copy Target.Offset(, 1)
  
 Else

    MsgBox "No match found."

End If

Application.EnableEvents = True
End Sub