Question

I am using excel to keep track of certain data in the following form:

Date    Name   ID

1/01,   A,     1

1/01,   B,     2

1/02,   C,     3

1/02,   D,     4

1/03,   E,     5

I want to set up a schedule based on this data, but in order to do that, I need to find and output the ranges for samples that have the same date.

Example:

1/01: IDs 1-2

1/02: IDs 3-4

1/03: ID 5

How would I go about doing this? I tried using lookup, but it gets majorly confused when dealing with duplicate data (and it only finds one instance at any rate).

Clarification:

Basically, I want to find all the values that have the date 1/02, and get the lowest and highest IDs that have these dates.

Answer 1

Below is the code to meet your requirement as I understand it.

I assume column “A” contains Excel dates with a display format of mm/dd.

To the moderately experienced VBA programmer this is a trivial task so I am assuming you are not a VBA programmer or are very inexperienced. I have avoided the more advanced features. However, I have used formatting (dates displayed as mm/dd, bold, alignment), which you did not ask for, to show you how it is done. I have not told you how to access the VB Editor or how to create a module. If you do not know, please ask. I had someone put some code in the wrong place a while back and it was a difficult to explain how to get it out.

I had said what statements or blocks of statements are doing but have not provided full explanations. The idea is to tell you enough to allow you to make minor changes to the code and to allow you look features up in Help if you want to go further. I do recommend you go further. Once you are over the first hill, most of VBA is flat countryside. However, there are some serious mountains if you want to go even further.

I have assumed all the Ids are integers. If they are strings, you must change the type of IdCrnt, SummaryIdFirst and SummaryIdLast from Integer to String. If they are values like: “1”, “2”, “2a”, “2b”, “3”, “4”, etc you will have a problem because “10” is less than “1a”.

I have placed the summary in unused columns within the source worksheet “Sheet1”. Change the names of the worksheets in the With statements as required.

Option Explicit

  ' I assume the sample data in your question is a simplification
  ' with many irrelevant columns omitted.  The use of constants means
  ' that you can change the columns used by changing the following
  ' four statements.
  Const ColSrcDate As Integer = 1     ' "A"
  Const ColSrcId As Integer = 3       ' "C"
  Const ColDestDate As Integer = 6    ' "F"
  Const ColDestId As Integer = 7      ' "G"
Sub SummariseTasks()

  Dim DateCrnt As Date
  Dim Found As Boolean
  Dim IdCrnt As Integer
  Dim RowCrnt As Integer
  Dim RowLast As Integer

  ' I have used three arrays to hold the summary data.  There are better
  ' techniques but I think this is the easiest for a beginner.
  Dim SummaryDate() As Date
  Dim SummaryIdFirst() As Integer   ' Change type
  Dim SummaryIdLast() As Integer    ' as necessary

  Dim InxSummaryCrnt As Integer     ' One index for all three arrays
  Dim InxSummaryCrntMax As Integer

  With Sheets("Sheet1")

    ' Find the last row on the worksheet
    RowLast = .Cells.SpecialCells(xlCellTypeLastCell).Row

    ' Size arrays to bigger than could be required and use
    ' InxSummaryCrntMax to identify the last entry used.
    ' You can use Redim Preserve to make an array bigger but
    ' I avoid using Redim Preserve more than necessary because
    ' it is expensive in memory and time.
    ReDim SummaryDate(1 To RowLast)
    ReDim SummaryIdFirst(1 To RowLast)
    ReDim SummaryIdLast(1 To RowLast)
    InxSummaryCrntMax = 0

    ' Most experienced programmers would load the entire source range
    ' into an array.  We now know that using arrays is not that much
    ' faster than accessing individual cells within the worksheet so
    ' I have gone for simplicity.

    ' Introduction to syntax of addressing a worksheet
    '   .Cells      The entire worksheet identified by the With statement
    '   .Cells(R,C) The single cell with row = R and column = C.  R must
    '               be an integer while C can be a letter or a number with
    '               "A"=1. "B"=2. etc.

    For RowCrnt = 2 To RowLast
      If IsEmpty(.Cells(RowCrnt, ColSrcDate).Value) Then
        ' I assume that if the date column is empty, the row is empty
      Else
        ' Extract values to variables
        DateCrnt = .Cells(RowCrnt, ColSrcDate).Value
        IdCrnt = .Cells(RowCrnt, ColSrcId).Value
        ' Look for date in SummaryDate array
        Found = False
        For InxSummaryCrnt = 1 To InxSummaryCrntMax
          If SummaryDate(InxSummaryCrnt) = DateCrnt Then
            Found = True
            Exit For
          End If
        Next
        If Found Then
          ' This date already recorded.  Update IdFirst
          ' and IdLast if necessary.
          If SummaryIdFirst(InxSummaryCrnt) > IdCrnt Then
            SummaryIdFirst(InxSummaryCrnt) = IdCrnt
          End If
          If SummaryIdLast(InxSummaryCrnt) < IdCrnt Then
            SummaryIdLast(InxSummaryCrnt) = IdCrnt
          End If

        Else
          ' First time this date found, Create
          ' new entry in summary arrays.
          InxSummaryCrntMax = InxSummaryCrntMax + 1
          SummaryDate(InxSummaryCrntMax) = DateCrnt
          SummaryIdFirst(InxSummaryCrntMax) = IdCrnt
          SummaryIdLast(InxSummaryCrntMax) = IdCrnt
        End If
      End If
    Next

  End With

  ' The source data is now summarised in the Summary arrays.
  ' I have not sorted by date.  This is possible if the source rows
  ' are not in date order but I would need more information to
  ' identify the best approach.

  With Sheets("Sheet1")

    ' Erase any data from a previous run of this macro.
    ' Erase any formatting in case you have used bold or strikeout
    ' to highlight particular tasks as important or done
    With .Columns(ColDestDate).EntireColumn
      .ClearContents
      .ClearFormats
    End With
    With .Columns(ColDestId).EntireColumn
      .ClearContents
      .ClearFormats
    End With

    ' Create column headers
    With .Cells(1, ColDestDate)
      .Value = "Date"
      .Font.Bold = True
      .HorizontalAlignment = xlRight
    End With
    With .Cells(1, ColDestId)
      .Value = "Id range"
      .Font.Bold = True
      .HorizontalAlignment = xlCenter
    End With

    ' Store summary data
    RowCrnt = 2
    For InxSummaryCrnt = 1 To InxSummaryCrntMax
      With .Cells(RowCrnt, ColDestDate)
        .NumberFormat = "mm/dd"
        .Value = SummaryDate(InxSummaryCrnt)
      End With
      With .Cells(RowCrnt, ColDestId)
        .Value = "'" & SummaryIdFirst(InxSummaryCrnt) & "-" & _
                       SummaryIdLast(InxSummaryCrnt)
        .HorizontalAlignment = xlCenter
      End With
      RowCrnt = RowCrnt + 1
    Next

  End With
End Sub

Best of luck.