Link to home
Start Free TrialLog in
Avatar of Norman Fite
Norman Fite

asked on

Write a Worksheet_SelectionChange to hide Rows above and below selected start time and end time

How do you write a Worksheet Selection Change to Hide rows before a start time and hide rows after the end time.
  My schedule starts at row 5 Column D.  It contains entries in 15 minute increments starting at 12:00am. and extends 11:45pm, row 101.
In B7 and B8 I have Start time Row: and End time Row, calculations.  So I know (form example) that if the start time is 6:00am then that is row 30 and If stop time is 19:00, then that is row 81.
  So what I would like to do is have a change event, that will (in the example above), Hide rows 29 through Row6, and Hide Rows 82 through Row 101.

This is variable because AB5 (work Start Time) and AC5 (work end time) can change, but the start time Row Count and End time Row count B7 and B8 will automatically update when AB5 and AC5 is changed. (I have already done that).

I hope this makes sense...
Thanks,
Norm
Avatar of Subodh Tiwari (Neeraj)
Subodh Tiwari (Neeraj)
Flag of India image

I think BeforeDoubleClick event would be better instead of SelectionChange event. Because since B7 and B8 contain the Start Row and End Row and in case of SelectionChange event once you select either of them, the SelectionChange event code will get triggered and you won't be able to edit B7 and B8 if you want to and moreover since you want the rows to be hidden up to Row#6, B7 and B8 will not be visible once rows are hidden.

The following code is BeforeDoubleClick event code and as per the code once you double click either B7 or B8, the rows will be hidden accordingly and if you want to unhide the rows again, you may double click any cell in column D and the hidden rows will be visible again.

To implement this code to your workbook, right click on Sheet Tab --> View Code --> and paste the code given below into the opened code window and save your workbook as Macro-Enabled Workbook.

You may tweak the code if required by following the comments added in the code.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim sRow As Variant
Dim eRow As Variant
Dim lRow As Long

lRow = Cells(Rows.Count, "D").End(xlUp).Row     'Total Rows with data in column D
sRow = Range("B7").Value                        'Start Row should be mentioned in B7
eRow = Range("B8").Value                        'End Row should be mentioned in B8

If lRow < 6 Then Exit Sub
If Not IsNumeric(sRow) Or Not IsNumeric(eRow) Then
    MsgBox "B7 and B8 must contain a numeric value.", vbExclamation
    Exit Sub
End If

sRow = CLng(sRow)
eRow = CLng(eRow)

If Target.Address(0, 0) = "B7" Or Target.Address(0, 0) = "B8" Then
    If Target.Address(0, 0) = "B7" Or Target.Address(0, 0) = "B8" Then
        If sRow > 0 And eRow > 0 And sRow > 6 And eRow > sRow Then
            Rows("6:" & sRow - 1).Hidden = True
            Rows(eRow + 1 & ":" & lRow).Hidden = True
        End If
        Cancel = True
    End If
ElseIf Target.Column = 4 Then
    Rows.Hidden = False
    Cancel = True
End If
End Sub

Open in new window

Avatar of Norman Fite
Norman Fite

ASKER

Are you saying that if row B7 is hidden, that the change will not occur if the End time is changed?  I thought that excel would update hidden cells ?
Your question title includes Worksheet_SelectionChange and if the cells B7 and B8 are selected and get hidden then, you won't be able to select them again to trigger the Worksheet_SelectionChange code.

It seems you wanted a Change Event code but if the B7 and B8 are being populated with the help of Formulas and if the values in B7 and B8 get changed due to a formulas when sheet recalculates, the change event won't be triggered.
The change event will only be triggered if you manually change the B7 and B8.

Considering all those points, I suggested you the BeforeDoubleClick event. Did you try that?
Not yet, I had hoped to have it update without selecting a button.  This is why I come to you guys, I learn a lot every time I talk to you..
  I will think about it...and give it a try.  Although it would be more elegant without the update button..
Thanks,
Norm
What formulas you are having in B7 and B8?
Now when you know that Formulas don't trigger the Change Event but if changing other cells on the Sheet change the output returned by the formulas in B7 and B8, we may put a code for change event for the cells which when changed manually may change the values in B7 and B8.

There is another event which is called Worksheet_Calculate which gets triggered each time when the Sheet recalculates, we may also consider that event provided I know that what formulas B7 and B8 contain.
I have the Start Time selection in AB5 (drop down) and End Time Selection in AC5 (drop down).  Those cells will be visible.  The row count formula for start and end rows are in B7 and B8.  
B7 formula "Start time row"
=IFERROR(MATCH(StartTime,Times,0)+5,6)

B8 Formula "End time row"
=IFERROR(MATCH(EndTime,Times,0)+4,6)

of course I have other functions working off of B7, lot of code to change if I need to move it..
thanks,
Norm
If that's the case, we can place the Change Event code so that once you select the Start Time or End Time from AB5 or AC5, the change event will be triggered and hide the rows as desired based on the row# returned in the cells B7 and B8.

So place the following code on Sheet Module for the Sheet Change Event and let me know if that works as desired.


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Dim sRow As Variant
Dim eRow As Variant
Dim lRow As Long

lRow = Cells(Rows.Count, "D").End(xlUp).Row     'Total Rows with data in column D
sRow = Range("B7").Value                        'Start Row should be mentioned in B7
eRow = Range("B8").Value                        'End Row should be mentioned in B8

If lRow < 6 Then Exit Sub

If Not IsNumeric(sRow) Or Not IsNumeric(eRow) Then
    MsgBox "B7 and B8 must contain a numeric value.", vbExclamation
    Exit Sub
End If

sRow = CLng(sRow)
eRow = CLng(eRow)

On Error GoTo Skip

If Target.Address(0, 0) = "AB5" Or Target.Address(0, 0) = "AC5" Then
    Application.EnableEvents = False
    If Range("AB5").Value <> "" And Range("AC5").Value <> "" Then
        If sRow > 0 And eRow > 0 And sRow > 6 And eRow > sRow Then
            Rows("6:" & sRow - 1).Hidden = True
            Rows(eRow + 1 & ":" & lRow).Hidden = True
        End If
    Else
        Rows.Hidden = False
    End If
End If

Skip:
Application.EnableEvents = True
End Sub

Open in new window

I am getting an ambiguous name detected: Worksheet_Change error.
I have a worksheet change on the sheet already.  Does that make a difference?
Norm
(again my ignorance is showing)
Yes, you can have multiple events code on a Sheet Module but you cannot have more than one occurrences of the same event code on the Sheet Module.
What the other Sheet Change Event code is there for?
You might be having an IF condition to check when to trigger the Change Event code and you may add an ElseIf conditional to have another scenario for Sheet Change Event.

So all you need is to incorporate this code into the existing change event code.
here is my code:
Worksheet-change-code.txt
Create a backup copy of your file so that if something goes wrong, you will have a backup file.
And then replace your existing code for Change Event with the following Change Event code and see if that works for you.
Let your Selection Change Event code as it is, no need to change it.

Dim DbCol As Long
Dim DbSht As String
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Dim sRow As Variant
Dim eRow As Variant
Dim lRow As Long

lRow = Cells(Rows.Count, "D").End(xlUp).Row     'Total Rows with data in column D
sRow = Range("B7").Value                        'Start Row should be mentioned in B7
eRow = Range("B8").Value                        'End Row should be mentioned in B8

If Target.Address(0, 0) = "AB5" Or Target.Address(0, 0) = "AC5" Then
    On Error GoTo Skip
    If IsNumeric(sRow) And IsNumeric(eRow) Then
        sRow = CLng(sRow)
        eRow = CLng(eRow)
        Application.EnableEvents = False
        If Range("AB5").Value <> "" And Range("AC5").Value <> "" Then
            If sRow > 0 And eRow > 0 And sRow > 6 And eRow > sRow Then
                Rows("6:" & sRow - 1).Hidden = True
                Rows(eRow + 1 & ":" & lRow).Hidden = True
            End If
        Else
            Rows.Hidden = False
        End If
    End If
    Application.EnableEvents = True
    On Error GoTo 0
End If

If Not Intersect(Target, Range("E6:X101")) Is Nothing And Range("B2").Value = False Then 'Any Change withing the Schedule but not on Schedule Refresh
        DbSht = Cells(110, Target.Column).Value 'Get Sheet Name
        DbCol = Cells(111, Target.Column).Value 'Get Sheet Column
'On Duration Change
        If Cells(5, Target.Column).Value = "Dur." And Cells(111, Target.Column).Value <> Empty Then 'Duration Change and Check for proper datbase coluumn
                'Update Colors
                If Range("B6").Value <> Empty Then Range(Cells(Target.Row, Target.Column), Cells(Target.Row + Range("B6").Value - 1, Target.Column + 1)).Interior.Color = 16777215 'Clear Previos Colors Based on Previous Duration (if any)
                Range("B5").Value = Target.Value 'Set New Duration in holding cell
                If Target.Value <> Empty Then Range(Cells(Target.Row, Target.Column), Cells(Target.Row + Range("B6").Value - 1, Target.Column + 1)).Interior.Color = Range("FillColor").Interior.Color  'Add New Color
                Sheets("" & DbSht & "").Cells(Target.Row, DbCol).Value = Range("B6").Value 'Place Appointment Info in Database
         End If
'On Details Change
        If Cells(5, Target.Column).Value = "Details" And Cells(111, Target.Column).Value <> Empty Then
        Sheets("" & DbSht & "").Cells(Target.Row, DbCol + 1).Value = Target.Value
            If Target.Value <> Empty Then 'To Send Email for newly Scheduled Appointment
                Sheet16.Range("B2").Value = Target.Address 'Enter Address of Changed Cell
                SendNewApptEmail
            End If
        End If
        
End If

If Not Intersect(Target, Range("B3,AB4")) Is Nothing Then ScheduleRefresh 'Refresh Schedule on Date Change or Start Day Change
Skip:
Application.EnableEvents = True
End Sub

Open in new window

It is 2:15 AM here so I will log off now.
Please test the code and leave your feedback here.
I will speak to you tomorrow.
Thank you for all your help
Norm
Ok I have added and tried the code.
  The last row of the Schedule is 101 and it does not need to hide beyond that row.
 Is there a way to change the hidden rows if the start or end time changes, this doesn't seem to do that.
Will I need to move B7 and B8, to another location that will not be hidden?
Thanks for all your work..
Norm
ASKER CERTIFIED SOLUTION
Avatar of Subodh Tiwari (Neeraj)
Subodh Tiwari (Neeraj)
Flag of India image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thank you... I will work on this, I think I am going to re-arrange my on sheet setups and place them on a setup page so that I will not have issue with hiding lines..
  You have been a great help..
Thanks,
Norm
Thank you for your help, I will let you know how it goes after I change my setups to a setup page..as I said in my last note to you..
  Thank you for your patience and you EXPERT, help.  I learned a great deal..  You get Two Thumbs Up....

Norm
You're welcome Norm! Glad I could help.
Thanks for the feedback and kind words.
Just an update for you; I moved some formulas to a different area of the sheet, and I added a Rows.Hidden = False , before the row count and it seems to work well.
  Thank you again for all your help
Norm
Great! Thanks for the update!