VBA for hiding columns based on inputted date

AlexCHI

New Member
Joined
Sep 28, 2017
Messages
19
I am using Excel 2007 to make an attendance sheet with cell "S9" starting as January 01, 2017 through "NS9" as December 31, 2017. I am hoping that if the user of the form inputs a date (1/03/2017 as an example) in a specified cell (say B3) then the columns with other dates would "temporarily" hide and showing just the column with the user-inputted date. In this example, column U with 1/03/2017 would show while the columns with other 364 dates would hide. And if the specified cell (i.e. B3) is left blank then all columns showing 365 dates would appear again.

I figured this would save time to scroll through many columns before getting to the date in question. Really appreciate if anyone would help me with the VBA code to accomplish this! Thank you in advance.
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Here is some air code.

Code:
Sub HideCols()
    Dim crit As Date
    Dim lc As Long
    Dim i As Long
    Application.ScreenUpdating = False
    crit = Range("B3").Value
    lc = Cells(9, Columns.Count).End(xlToLeft).Column
    For i = 3 To lc
        If Cells(9, i) <> crit Then
            Cells(9, i).EntireColumn.Hidden = True
        End If
    Next i
    Application.ScreenUpdating = True






End Sub
 
Upvote 0
something along the lines of, as a worksheet change event

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, rng
Set rng = Range("s9:ns9")
If Target.Column = 2 And Target.Row = 3 And Target <> "" Then
Columns("s:ns").Hidden = True
For Each c In rng
If c.Value = Range("b3").Value Then
c.Columns.Hidden = False
End If
Next c
End If
If Target.Column = 2 And Target.Row = 3 And Target = "" Then
Columns("s:ns").Hidden = False
End If
End Sub
 
Upvote 0
I would use a script like this:

When you enter a date in Range("B3") the script will select the cell with that date.
This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet tab
Select View Code from the pop-up context menu
Paste the code in the VBA edit window

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B3")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Dim c As Range
    For Each c In Range("S9:NS9")
    If c.Value = Target.Value Then c.Select: Exit Sub
    Next
End If
End Sub
 
Upvote 0
Welcome to the MrExcel board!

If I have understood correctly, then here is another option that addresses the relevant columns directly, rather than looping through them singly. This is also Worksheet_Change code so is implemented as described in post #4 (You can only have one Worksheet_Change event code for a workshhet so to test any one you need to remove/disable the others)

I have assumed that B3 can only hold a 2017 date or be blank.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("B3")) Is Nothing Then
    Application.ScreenUpdating = False
    If IsEmpty(Range("B3").Value) Then
      Columns("S:SN").Hidden = False
    Else
      Columns("S:SN").Hidden = True
      Columns("S").Offset(, Range("B3").Value - Range("S9").Value).Hidden = False
    End If
    Application.ScreenUpdating = True
  End If
End Sub
 
Upvote 0
Peter you said:
"You can only have one Worksheet_Change event code for a workshhet"

I would call this having two sheet change events in one sheet. But maybe you don't consider this two.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim c As Range
If Not Intersect(Target, Range("B3")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Range("S9:NS9").Interior.ColorIndex = xlNone
    For Each c In Range("S9:NS9")
    If c.Value = Target.Value Then c.Select: c.Interior.ColorIndex = 4
    Next
End If
[COLOR=#ff0000]'Start second sheet change event[/COLOR]
If Not Intersect(Target, Range("B5")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Range("S9:NS9").Interior.ColorIndex = xlNone
    For Each c In Range("S9:NS9")
    If c.Value = Target.Value Then c.Select: c.Interior.ColorIndex = 5
    Next
End If

Application.EnableEvents = True
End Sub




Welcome to the MrExcel board!

If I have understood correctly, then here is another option that addresses the relevant columns directly, rather than looping through them singly. This is also Worksheet_Change code so is implemented as described in post #4 (You can only have one Worksheet_Change event code for a workshhet so to test any one you need to remove/disable the others)

I have assumed that B3 can only hold a 2017 date or be blank.

Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("B3")) Is Nothing Then
    Application.ScreenUpdating = False
    If IsEmpty(Range("B3").Value) Then
      Columns("S:SN").Hidden = False
    Else
      Columns("S:SN").Hidden = True
      Columns("S").Offset(, Range("B3").Value - Range("S9").Value).Hidden = False
    End If
    Application.ScreenUpdating = True
  End If
End Sub
 
Upvote 0
Peter you said:
"You can only have one Worksheet_Change event code for a workshhet"

I would call this having two sheet change events in one sheet. But maybe you don't consider this two.
You can certainly deal with any number of circumstances in the event code & I wouldn't argue with that. However, your sample code only has one Private Sub Worksheet_Change(ByVal Target As Range)/End Sub block.

My comment was intended to ensure that the OP didn't test your code, leave it there and paste mine above/below, making two Worksheet_Change codes in the same worksheet module triggering an 'Ambiguous name detected' error. Perhaps 'procedure' would have been better than 'code'?
 
Last edited:
Upvote 0
Gratitude to all who helped me in this thread! I picked one (i.e., the vba in post #3 provided by SteveO59L) and it worked exactly the way I wished. And now, may I ask how I can tweak the following vba so that the user can input multiple dates (instead of just one date) in cell B3 and the columns with those specified dates will show while all other dates will hide? Thank you all in advance!
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, rng
Set rng = Range("s9:ns9")
If Target.Column = 2 And Target.Row = 3 And Target <> "" Then
Columns("s:ns").Hidden = True
For Each c In rng
If c.Value = Range("b3").Value Then
c.Columns.Hidden = False
End If
Next c
End If
If Target.Column = 2 And Target.Row = 3 And Target = "" Then
Columns("s:ns").Hidden = False
End If
End Sub
 
Upvote 0
If I have understood correctly, then here is another option that addresses the relevant columns directly, rather than looping through them singly.

Hi Peter,

Thank you very much for all your codes to help me complete my worksheet; it is coming along so well! I have applied your worksheet_change code for displaying only the columns of inputted day of the week (based on value in cell B5) with the another worksheet_change code you wrote for hiding columns based on inputted date (based on value in B3) so the VBA Worksheet_Change codes are now like this...

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("B3")) Is Nothing Then
    Application.ScreenUpdating = False
    If IsEmpty(Range("B3").Value) Then
      Columns("T:NT").Hidden = False
    Else
      Columns("T:NT").Hidden = True
      Columns("T").Offset(, Range("B3").Value - Range("T9").Value).Hidden = False
    End If
    Application.ScreenUpdating = True
  End If
  
  Dim sDay As String
  Dim rFound As Range
  Dim c As Long
  
  If Not Intersect(Target, Range("B5")) Is Nothing Then
    Application.ScreenUpdating = False
    sDay = Left(Range("B5").Value, 3)
    Columns("T:NT").Hidden = False
    If Len(sDay) > 0 Then
      Set rFound = Range("S10:NT10").Find(What:=sDay, After:=Range("S10"), LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, SearchDirection:=xlNext, SearchFormat:=False)
      If Not rFound Is Nothing Then
        Columns("T:NT").Hidden = True
        For c = rFound.Column To Columns("NT").Column Step 7
          Columns(c).Hidden = False
        Next c
      End If
    End If
    Application.ScreenUpdating = True
  End If
End Sub

My question now, hoping you could help me address, is how to tweak the first portion of the code so the user of the form can also input multiple dates in cell B3 and columns reflecting those dates can display while other dates will hide? As the code stands now, only one date can be inputted in cell B3.


Much appreciated for all your help, Peter.
 
Upvote 0
The existing code expects to find a date (or nothing) in cell B3. If you want to be able to input multiple dates into that cell then that cell will contain nothing or a date or a text string representing multiple dates.
1. How do you envisage multiple dates being entered? eg With a space between each date, or a comma, or a comma space or Alt+Enter etc.
2. How accurate do you think the user will be with entering those dates with a strict format?
 
Upvote 0

Forum statistics

Threads
1,224,808
Messages
6,181,072
Members
453,020
Latest member
mattg2448

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top