• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 215
  • Last Modified:

Excel, at a glance events data from dataset

This is a follow on question from question 26937769.

Basically, I have a list of holidays (this list will change and is about 1000 holidays).  The holidays are listed in one table with a start date, end date (if not only one day), destination and then a list of up to 30 people attending each holiday, with each name in a further column.

I need to take this raw data and display it one spreadsheet with the names of the people going on the holiday down the left hand side, the dates along the top, and the destination in the cell, ideally as a comment.  Cells need to be blank if the person is not on holiday, coloured green if they are going on one holiday that day, and coloured red if they are shown on two or more holidays (scheduling clash).

Many of the hoildays are single days.

I need to be easily able to update the "at a glance" view.

I've attached a sample dataset and a sample "at a glance" view, with only the first date shown as an example.

Many thanks! ee-question.xls
0
benlinton
Asked:
benlinton
  • 7
  • 6
1 Solution
 
Rory ArchibaldCommented:
Is it OK to populate the cells with the number of matches and then use conditional formatting to colour them, or do you need the cells to be left empty?
0
 
benlintonAuthor Commented:
They could have the numbers in and use conditional formatting as you suggest. As long as the destination can still appear as a comment...
0
 
Rory ArchibaldCommented:
How's this? I have added a custom number format of ;;; to the cells so you don't see the numbers.
Basic function code is:
Function GetHolidayStatus(strName As String, dteDate As Date, rngNames As Range, rngDates As Range, rngDests As Range)
   Dim lngIndex As Long, lngCounter As Long
   Dim varNames, varDates, varDests
   Dim strTemp As String
   If strName = "" Then Exit Function
   If Not IsDate(dteDate) Then
      GetHolidayStatus = CVErr(xlErrNum)
   Else
      varDates = rngDates.Value
      varDests = rngDests.Value
      ' check dates
      For lngIndex = LBound(varDates, 1) To UBound(varDates, 1)
         If varDates(lngIndex, 1) = dteDate Then
            If CheckNames(strName, rngNames.Rows(lngIndex)) Then
               lngCounter = lngCounter + 1
               strTemp = strTemp & vbCrLf & varDests(lngIndex, 1)
            End If
         ElseIf varDates(lngIndex, 1) < dteDate Then
            If IsDate(varDates(lngIndex, 2)) And varDates(lngIndex, 2) >= dteDate Then
               If CheckNames(strName, rngNames.Rows(lngIndex)) Then
                  lngCounter = lngCounter + 1
                  strTemp = strTemp & vbCrLf & varDests(lngIndex, 1)
               End If
            End If
         End If
      Next lngIndex
   End If
   If lngCounter > 0 Then
      GetHolidayStatus = lngCounter
      With Application.Caller
         If Not .Comment Is Nothing Then .Comment.Delete
         .AddComment Mid$(strTemp, 3)
      End With
   End If
End Function
Function CheckNames(strName As String, rngData As Range) As Boolean
   Dim varNames, lngRow As Long, lngCol As Long
   varNames = rngData.Value2
   For lngRow = LBound(varNames, 1) To UBound(varNames, 1)
      For lngCol = LBound(varNames, 2) To UBound(varNames, 2)
         If StrComp(varNames(lngRow, lngCol), strName, vbTextCompare) = 0 Then
            CheckNames = True
            Exit For
         End If
      Next lngCol
   Next lngRow
End Function

Open in new window

ee-question.xls
0
Cloud Class® Course: C++ 11 Fundamentals

This course will introduce you to C++ 11 and teach you about syntax fundamentals.

 
benlintonAuthor Commented:
From my iphone, that looks extremely promising...
0
 
benlintonAuthor Commented:
Apologies for the delay - been out of the office for a few days.

This solution looks superb, with one hitch.  I've created two sheets - one for Jan to Jun and one for Jul to Dec.  The second one appears to put the holidays in the right place, but the comments are starting again at the beginning of January.  Is this easily fixed?

Thanks again. final-solution.xls
0
 
Rory ArchibaldCommented:
I don't follow what you mean - can you give me an example?
0
 
benlintonAuthor Commented:
Sorry, the attached file should give you an example - the comments don't tie up to the holidays in the second sheet (Jul-Dec)
0
 
Rory ArchibaldCommented:
Where specifically? They look OK to me.
0
 
benlintonAuthor Commented:
In the July to December sheet, 2nd July, there is a comment saying Germany for Brown, but no colouring, and in the data sheet, there is no data shown for the 2nd July.  The comment actually relates to Jan 2nd...
0
 
benlintonAuthor Commented:
Does it look the same to you, or is my version not updating in some way?!

Thanks again for your help - your solution looks absolutely perfect in essence.
0
 
Rory ArchibaldCommented:
No, I see it. Small code revision:
Function GetHolidayStatus(strName As String, dteDate As Date, rngNames As Range, rngDates As Range, rngDests As Range)
   Dim lngIndex As Long, lngCounter As Long
   Dim varNames, varDates, varDests
   Dim strTemp As String
   If strName = "" Then Exit Function
   If Not IsDate(dteDate) Then
      GetHolidayStatus = CVErr(xlErrNum)
   Else
      varDates = rngDates.Value
      varDests = rngDests.Value
      ' check dates
      For lngIndex = LBound(varDates, 1) To UBound(varDates, 1)
         If varDates(lngIndex, 1) = dteDate Then
            If CheckNames(strName, rngNames.Rows(lngIndex)) Then
               lngCounter = lngCounter + 1
               strTemp = strTemp & vbCrLf & varDests(lngIndex, 1)
            End If
         ElseIf varDates(lngIndex, 1) < dteDate Then
            If IsDate(varDates(lngIndex, 2)) And varDates(lngIndex, 2) >= dteDate Then
               If CheckNames(strName, rngNames.Rows(lngIndex)) Then
                  lngCounter = lngCounter + 1
                  strTemp = strTemp & vbCrLf & varDests(lngIndex, 1)
               End If
            End If
         End If
      Next lngIndex
   End If
   GetHolidayStatus = lngCounter
   With Application.Caller
      If Not .Comment Is Nothing Then .Comment.Delete
      If lngCounter > 0 Then .AddComment Mid$(strTemp, 3)
   End With
End Function

Open in new window


Revised file attached.
final-solution.xls
0
 
benlintonAuthor Commented:
Absolutely superb.  Many many thanks.
0
 
Rory ArchibaldCommented:
Glad to help. :)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 7
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now