Solved

Holiday Table on Separate Sheet

Posted on 2014-04-29
5
223 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
5 Comments
 
LVL 46

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
 
LVL 1

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 46

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
 
LVL 1

Author Comment

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

Featured Post

Creating Instructional Tutorials  

For Any Use & On Any Platform

Contextual Guidance at the moment of need helps your employees/users adopt software o& achieve even the most complex tasks instantly. Boost knowledge retention, software adoption & employee engagement with easy solution.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…
Introduction to Processes

623 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