How to assign macro to cells in Excel

[Bram1212]

Hi!

I found this VBA code that helps me select a specific range when clicking on a cell and unselecting it when clicking on another cell:

Option Explicit

Private Sub worksheet_selectionchange(ByVal target As Range)

If Selection.Count = 1 Then

If Not Intersect(target, Range("B31")) Is Nothing Then

Call HideRangeB31

ElseIf Not Intersect(target, Range("D31")) Is Nothing Then

Call HideRangeD31

End If

End If

End Sub





Private Sub HideRangeB31()

Rows("32:34").Hidden = True

End Sub





Private Sub HideRangeD31()

Rows("32:34").Hidden = False

End Sub

However I can't seem to figure out how I multiply this action. For instance when selecting B35 hide row 36:38 and when selecting D35 showing row 36:38. When selecting B39 hide row 40:42 and when selecting D39 showing row 40:42 and so on.

Also it would be ideal if it only applies when clicking on the cell (or for example only with CNTRL+click combo) so that it does not open, hide when I go over it with browsing through arrow keys.

If any help is available that will be appreciated!

 

[kevin9999]

Also it would be ideal if it only applies when clicking on the cell (or for example only with CNTRL+click combo) so that it does not open, hide when I go over it with browsing through arrow keys.

That being the case, I would use a double-click event code instead. Please try the following on a copy of your workbook.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
    On Error GoTo Escape
    Application.EnableEvents = False
    cancel = True
    
    If Target.Column = 2 Then ActiveCell.Offset(1).Resize(3).EntireRow.Hidden = True
    If Target.Column = 4 Then ActiveCell.Offset(1).Resize(3).EntireRow.Hidden = False
    
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub

 

[Bram1212]

Hi Kevin.

This is amazing already, thank you very much.

If it would be possible, is there a way to have it start at row 31 and then every 4 rows. The 3 rows that are being hidden/shown do not need the ability to also have 3 hidden/shown rows again. Code is basically a workaround for the excel group/ungroup function.

So row 31 hides/shows 32:34
Row 35 same for 36:38
39 for 40:42

And so on.

If not the double click will make it dummy proof enough so don't bother if it is not easily achievable.

And again thank you for your help.

 

[kevin9999]

Please try the following:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
    On Error GoTo Escape
    Application.EnableEvents = False
    cancel = True
    
    If Target.Row >= 31 And ((Target.Row + 1) Mod 4) = 0 Then
        If Target.Column = 2 Then ActiveCell.Offset(1).Resize(3).EntireRow.Hidden = True
        If Target.Column = 4 Then ActiveCell.Offset(1).Resize(3).EntireRow.Hidden = False
    End If
    
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub

 

[Bram1212]

Yes this is perfect!! Thank you so much Kevin.

 

[kevin9999]

Happy to help, and thanks for the feedback

 

[Artik]

Although the BeforeDoubleClick event seems better for this task, you can also use the SelectionChange event, as you originally thought.
The code below distinguishes between keyboard and mouse navigation - it does not respond to the keyboard.

The code should be placed at the beginning of the sheet module.

Option Explicit

Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

Const VK_LEFT = &H25
Const VK_UP = &H26
Const VK_RIGHT = &H27
Const VK_DOWN = &H28
Const VK_RETURN = &HD
Const VK_TAB = &H9
Const VK_PRIOR = &H21    'PgUp
Const VK_NEXT = &H22    'PgDwn
Const VK_MENU = &H12    'Alt


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub

    If GetKeyState(VK_UP) >= 0 And GetKeyState(VK_DOWN) >= 0 And _
       GetKeyState(VK_LEFT) >= 0 And GetKeyState(VK_RIGHT) >= 0 And _
       GetKeyState(VK_PRIOR) >= 0 And GetKeyState(VK_NEXT) >= 0 And _
       GetKeyState(VK_TAB) >= 0 And GetKeyState(VK_RETURN) >= 0 Then

        On Error GoTo Escape
        Application.EnableEvents = False

        If Target.Row >= 31 And ((Target.Row + 1) Mod 4) = 0 Then
            If Target.Column = 2 Then ActiveCell.Offset(1).Resize(3).EntireRow.Hidden = True
            If Target.Column = 4 Then ActiveCell.Offset(1).Resize(3).EntireRow.Hidden = False
        End If
Continue:
        Application.EnableEvents = True

    End If

    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub

Artik

 

[Bram1212]

Thanks Artik but the solution from Kevin works perfect.

@kevin9999 would it also be possible to have it work on columns 21&23? I tried reworking it but keep running into an error.

 

[kevin9999]

would it also be possible to have it work on columns 21&23

This should do it

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
    On Error GoTo Escape
    Application.EnableEvents = False
    cancel = True
    
    If Target.Row >= 31 And ((Target.Row + 1) Mod 4) = 0 Then
        If Target.Column = 2 Or Target.Column = 21 Then ActiveCell.Offset(1).Resize(3).EntireRow.Hidden = True
        If Target.Column = 4 Or Target.Column = 23 Then ActiveCell.Offset(1).Resize(3).EntireRow.Hidden = False
    End If
    
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub

 

[Bram1212]

Indeed it does. You made my day!