MACRO to Hide and Unhide Rows

[Brampton76]

Each month I filter data and extract items sold - by contractor and date. I then copy and paste special values into a contractor specific sheet. There are some 400 items which are replicated in each of the 90 or so contractor sheets but because not all contractors use all the different items I 'tick' the cell in column A using some coding, for the items that are specific to that contractor. To make it easier to read the contractor sheets I then hide (manually) the 'unticked' rows and then later on, to make it easier to drop in the copied date I unhide all the rows. I would be grateful for some coding that would first look to see if there is a 'tick' in the box and if not, then hide that row. And secondly, some coding that would unhide all hidden rows. I could then run these as macros from buttons on each sheet. Many thanks

Glenn

 

[Ralajer]

Glenn,

The following code should do what you need. I assume that the non-ticked cells are blank, as the macro hides any row in the used range that is empty. You will just have to change the highlighted column letter to match your sheet.

Macro to hide tick'd rows

Sub HideNotTick()
    On Error Resume Next
    With ActiveSheet
    Intersect(.UsedRange, .Columns("[COLOR="Red"][B]L[/B][/COLOR]")).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
    End With
    On Error Goto 0
End Sub

Macro to unhide all hidden rows on a sheet

Sub unHideAll()
    ActiveSheet.Cells.EntireRow.Hidden = False
End Sub

 

[Brampton76]

Many thanks - it works but after a fashion. Firstly I get a Run-time error '13' with the following code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("A7:A52")) Is Nothing Then
If Target.Value = 0 Then Target.FormulaR1C1 = "P" Else Target.Value = ""
With Target.Characters(Start:=1, Length:=1).Font
.Name = "Wingdings 2"
.FontStyle = "Bold"
.Size = 12
End With
End If
Application.EnableEvents = True
End Sub

If I ignore this then the coding works and hides all the columns that are not ticked. It seems then to disable the coding that creates the 'tick' because after I have unhidden everything, I am unable to 'tick' any of the boxes. I have placed the above coding on the Worksheet (SelectionChange) and the coding you provided under This Workbook. I am wondering if I have set it up wrong? Sorry I forgot - I an on Excel 2007 with Windows 7.

Glenn

 

[Ralajer]

The selection change event code is being triggered by the hiding and unhiding of rows. The problem with the code is that if the Target (new range selection) is more than one cell it creates an error when you try to evaluate it Target.value = 0. The error if ignored will kill the Worksheet_SelectionChange sub which leaves the Application.EnableEvents = False which turns off events which is what trigger the sub in the first place.


Try replacing the Selection change code with the following which will take care of that issue.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.EnableEvents = False
    On Error GoTo errExit
    
    If Not Intersect(Target, Range("A7:A52")) Is Nothing And Target.Count = 1 Then
        If Target.Value = Empty Then
            Target.FormulaR1C1 = "P"
            With Target.Characters(Start:=1, Length:=1).Font
                .Name = "Wingdings 2"
                .FontStyle = "Bold"
                .Size = 12
            End With
        Else
            Target.Value = Empty
    
        End If
    End If
errExit:
    Application.EnableEvents = True
End Sub

And change my code to

Sub HideNotTick()
    Application.EnableEvents = False
    On Error Resume Next
    With ActiveSheet
    Intersect(.UsedRange, .Range("A7:A52")).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
    End With
    On Error GoTo 0
    Application.EnableEvents = True
End Sub

Sub unHideAll()
    Application.EnableEvents = False
    ActiveSheet.Cells.EntireRow.Hidden = False
    Application.EnableEvents = True
End Sub

 

[Brampton76]

Rob,

Many thanks, this works a treat. It will save me a lot of time and I can't thank you enough.

Kind Regards
Glenn