Forum Discussion

YlvaElise's avatar
YlvaElise
Copper Contributor
Mar 17, 2023

Run a macro

Hi all,

 

I want to run a Macro. What I want it to do: When I select Intern, I want the file to show the yellow and blank columns, and when I select Extern, I want it to show the yellow and green columns.  

  • NikolinoDE's avatar
    NikolinoDE
    Gold Contributor

    YlvaElise 

    For example, you can try this code 🙂

     

    Sub Hide_Unhide_Columns()
    
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    Set ws = ThisWorkbook.Sheets("Sheet1") 'Change sheet name as needed
    Set rng = ws.Range("A1:G1") 'Change range as needed For Each cell In rng
    If cell.Value = "Intern" Then 'Change value as needed cell
    .EntireColumn.Hidden = False 'Show column Else
    If cell.Value = "Extern" Then 'Change value as needed cell
    .EntireColumn.Hidden = False 'Show column Else cell
    .EntireColumn.Hidden = True 'Hide column
    End If
    Next cell
    End Sub

     

    You need to customize the code to suit your needs and associate it with a button click or worksheet switch event.

    I hope this helps you.

  • YlvaElise 

    It would be much easier if you added a column that contains a code (for example a single letter) corresponding to whether the row is for Intern or Extern only.

    With the current setup:

    Right-click the sheet tab.

    Select 'View Code' from the context menu.

    Copy the following code into the worksheet module:

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim rng As Range
        Dim cel As Range
        If Not Intersect(Range("A1"), Target) Is Nothing Then
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            Range("A2:A1000").EntireRow.Hidden = False
            Select Case Range("A1").Value
                Case "Intern"
                    For Each cel In Intersect(Range("A2:A1000"), Me.UsedRange)
                        If cel.Interior.Color = RGB(168, 208, 141) Then
                            If rng Is Nothing Then
                                Set rng = cel
                            Else
                                Set rng = Union(cel, rng)
                            End If
                        End If
                    Next cel
                Case "Extern"
                    For Each cel In Intersect(Range("A2:A1000"), Me.UsedRange)
                        If cel.Interior.ColorIndex = xlColorIndexNone Then
                            If rng Is Nothing Then
                                Set rng = cel
                            Else
                                Set rng = Union(cel, rng)
                            End If
                        End If
                    Next cel
            End Select
            If Not rng Is Nothing Then
                rng.EntireRow.Hidden = True
            End If
            Application.EnableEvents = True
            Application.ScreenUpdating = True
        End If
    End Sub

    You may have to adjust the value RGB(168, 208, 141) to the precise color green that you used.

    The code will run automatically when you select Intern or Extern in A1.

Share

Resources