Solved

Holiday Table on Separate Sheet

Posted on 2014-04-29
5
207 Views
Last Modified: 2014-04-30
This is an extension of a question I asked here:

http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_28034274.html

I'd like to put the holidays in a separate sheet instead of in the table. I've put the "Holidays" table in a separate sheet. I'd like to be able to update the holiday sheet without affecting the table in case I want to delete a row.

See code below and attached file. Let me know if I need to be more clear about what I'm asking. Thanks!


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    Dim holidayTable As ListObject
    Dim aCell As Range
    Dim x As String
    Dim inRange As Boolean
    Dim CheckColumn As Long
    Dim Message As String
    Dim inTableRange As Range
    
    
    
    
    
    If Target.Column <> 10 Then
        Exit Sub
    End If
    
    Set holidayTable = Sheets("Sheet1").ListObjects("HolidayTable")
    
'   here make sure that we are selecting a cell in the table
    
    Set inTableRange = Intersect(Target, holidayTable.DataBodyRange)
    If inTableRange Is Nothing Then
        Exit Sub
    End If
    
    ' Ok... now we have selected a  "Click here to view" cell... lets check it out
    
    For Each aCell In holidayTable.ListColumns(11).Range [b]<<<<<< Point to Holiday Sheet[/b]
        'Skip header row
        If (aCell.Row <> 1) Then
         If testRange(Target.Row, aCell.Value2) Then
            
            Select Case Weekday(aCell.Value2)
            
                Case vbMonday
                    CheckColumn = 3
                Case vbTuesday
                    CheckColumn = 4
                Case vbWednesday
                    CheckColumn = 5
                Case vbThursday
                    CheckColumn = 6
                Case vbFriday
                    CheckColumn = 7
                Case vbSaturday
                    CheckColumn = 8
                Case vbSunday
                    CheckColumn = 9
            End Select
            
            If Cells(Target.Row, CheckColumn) <> "" Then
                Message = Message & vbCrLf & Format(aCell.Value2, "mm/dd/yy")
            End If
        End If
        End If
        
    Next
    
    If Message = "" Then
        MsgBox ("No Holidays Fall in this range")
    Else
        MsgBox ("These Holidays fall in this range" & vbCrLf & Message)
    End If
    
End Sub

Function testRange(tableRow As Long, datetoCheck As Date) As Boolean

    If datetoCheck >= Cells(tableRow, 1) And datetoCheck <= Cells(tableRow, 2) Then
        testRange = True
    Else
        testRange = False
    End If
End Function

Open in new window

WeekdayHolidaysV2.xlsm
0
Comment
Question by:tracyms
  • 2
  • 2
5 Comments
 
LVL 45

Accepted Solution

by:
aikimark earned 500 total points
ID: 40031067
I've renamed your lists/tables and tweaked the code in the attached file.  Is this the behavior you're seeking?
WeekdayHolidaysV2.xlsm
0
 

Author Comment

by:tracyms
ID: 40031155
Yes, this what I'm looking for but trying to incorporate into my spreadsheet.  In an effort not to change too much of what's already in my code, can I do the following:

- Keep my table name the same (Table1)
- Call my new table (on the "Holiday" sheet) "HolidayList"
- In my HolidayList table I have:

Holiday date in Column 1 (A) =  Format(aCell.Value2, "mm/dd/yy")
Holiday Day in Column 2 (B) = Cells(aCell.Row, 45).Value
Holiday Name in Column 3 (C) = Cells(aCell.Row, 47).Value

So, in the above columns would be equal to the below  in my code:
     Message = Message & vbCrLf & Cells(aCell.Row, 45).Value & " - " & Format(aCell.Value2, "mm/dd/yy") & " - " & Cells(aCell.Row, 47).Value


Column 29 is the "Click to view Holidays" column, which is this in my code:

 If Target.Column <> 29 Then
        Exit Sub
    End If

 I shouldn't need this line in my code since the holidays will no longer be in the original table but rather on the Holidays sheet:

For Each aCell In holidayTable.ListColumns(44).Range
        'Skip header row
        If (aCell.Row <> 9) Then
         If testRange(Target.Row, aCell.Value2) Then

I hope it makes sense! :-)


 Dim holidayTable As ListObject
    Dim aCell As Range
    Dim x As String
    Dim inRange As Boolean
    Dim CheckColumn As Long
    Dim Message As String
    Dim inTableRange As Range
    

    
    
    
    If Target.Column <> 29 Then
        Exit Sub
    End If
    
    
    Set holidayTable = Sheets("Courses").ListObjects("Table1")
    
 
    
'   here make sure that we are selecting a cell in the table
    
     Set inTableRange = Intersect(Target, holidayTable.DataBodyRange)
    If inTableRange Is Nothing Then
        Exit Sub
    End If
    
    ' Ok... now we have selected a  "Click here to view" cell... lets check it out
    
    For Each aCell In holidayTable.ListColumns(44).Range
        'Skip header row
        If (aCell.Row <> 9) Then
         If testRange(Target.Row, aCell.Value2) Then
            
            Select Case Weekday(aCell.Value2)
            
                Case vbMonday
                    CheckColumn = 10
                Case vbTuesday
                    CheckColumn = 11
                Case vbWednesday
                    CheckColumn = 12
                Case vbThursday
                    CheckColumn = 13
                Case vbFriday
                    CheckColumn = 14
                Case vbSaturday
                    CheckColumn = 15
                Case vbSunday
                    CheckColumn = 16
                    
                   
            End Select
            
            

   
   
   If Cells(Target.Row, CheckColumn) <> "" Then
              
                
                Message = Message & vbCrLf & Cells(aCell.Row, 45).Value & " - " & Format(aCell.Value2, "mm/dd/yy") & " - " & Cells(aCell.Row, 47).Value
            End If
        End If
        End If
        
    Next
    
    If Message = "" Then
        MsgBox ("No holidays fall in this range")
    Else
        MsgBox ("These holidays fall in this range: " & vbCrLf & Message)
        
        
    End If
    
    
   
End Sub

Function testRange(tableRow As Long, datetoCheck As Date) As Boolean

    If datetoCheck >= Cells(tableRow, 5) And datetoCheck <= Cells(tableRow, 18) Then
        testRange = True
    Else
        testRange = False
    End If
End Function

Open in new window

0
 
LVL 45

Expert Comment

by:aikimark
ID: 40031174
Unfortunately, no.  I based my changes on your workbook and the click in column 10 action of the code.  The names of lists/tables aren't really that important and can be easily changed.  Describe how you expect your users to interact with the Sheet1 worksheet and under what conditions you want to check the holiday dates.

Also, post a more representative worksheet.  Your last comment referenced columns that aren't populated in your prior upload.
0
 

Author Comment

by:tracyms
ID: 40033639
I got it to work by studying your code. Thanks.
0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now