look for 1st matching entry for multiple data ranges in worksheet

**joebelou** · 12-30-2008, 03:11 PM

hello. i'm new to excel and i'm really hoping for some serious help here. i have the basics down however i'm really stumped at this point. Let me try to explain my worksheet. the worksheet has a sheet for data which is used for drop list values in the new patient template sheet. the new patient template which is just that a blank entry sheet that the user duplicates and adds a new patient to the worksheet to track the visits made by medical staff. there could be over a hundred new patient sheets (each named by the patient) at any given time.
here is what i need help with: my sheet is setup on a monthly basis so each patient has a total of 4 - 5 weeks listed with entries for everytime a nurse visits that patient. what i need to know is how to search the cell entries for the first time a visit occurred and the date it occurred and this needs to be broken down by the 1st of the month - the 15th and then again for the 16th - the end of month for every patient sheet in the workbook. the ranges are not together that i need to search for example f14:f20, i14:i20, f35:f41 and so on for the first 15 days of the month. this all needs to happen like in a macro or somehow automatically. not sure but any assistance is extremely appreciated!!!

**Leith Ross** · 12-30-2008, 05:17 PM

Hello joebelou,

Welcome to the Forum!

It would help to see one these templates. Can you post and empty template?

Sincerely,
Leith Ross

**joebelou** · 12-30-2008, 10:39 PM

Thanks for the welcome! Here is the file...any assistance you can provide is greatly appreciated! Thanks for the quick response. If you have any questions please let me know.

**joebelou** · 12-30-2008, 10:43 PM

Sorry I didn't upload the file on the before response. Again, here is the file...any assistance you can provide is greatly appreciated! Thanks for the quick response. If you have any questions please let me know.

**Leith Ross** · 12-31-2008, 03:49 AM

Hello joebelou,

This macro will find the first visits for the 1st to 15th of the month and the 16th to 31st of the month. These dates are in the macro variables Visit1 and Visit2. You can expand the macro to suite your needs. It has been added to the attached workbook in Module2.

Sub FindFirstVisits()

  Dim CurMonth As Integer
  Dim FirstVisit
  Dim Rng As Range
  Dim Visit1, Visit2
  Dim VisitDate As Date
  Dim Weeks(1 To 5) As String
  Dim Wks As Worksheet
  
    
    Set Wks = Worksheets("New Patient")
    CurMonth = Month(Wks.Range("F10"))
    
      Weeks(1) = "F14:Z20"
      Weeks(2) = "F35:Z41"
      Weeks(3) = "F56:Z62"
      Weeks(4) = "F77:Z83"
      Weeks(5) = "F98:Z104"
        
        For I = 1 To 5
          Set Rng = Wks.Range(Weeks(I))
            For Each Cell In Rng
              If Cell.Text Like "[A-Za-z0-9]*" Then
                R = Rng.Row - 2
                C = Cell.Column
                VisitDate = Wks.Cells(R, C).MergeArea.Cells(1, 1).Value
                If Month(VisitDate) = CurMonth Then
                  Select Case Day(VisitDate)
                    Case 1 To 15
                      If IsEmpty(Visit1) Then Visit1 = VisitDate
                    Case 16 To 31
                      If IsEmpty(Visit2) Then Visit2 = VisitDate
                  End Select
                End If
              End If
            Next Cell
        Next I
    
End Sub

Sincerely,
Leith Ross

**joebelou** · 12-31-2008, 01:30 PM

Hi Leith!
Thanks so much for the extremely quick responses! At the risk of sounding really stupid (of course I did mention I'm very new to all this) where does the script place the results in the worksheet? I've attempted to run the macro and it doesn't seem to do anything that I can find anyway. Also, in the macro after you set the variables the line that states : Set Wks = Worksheets("New Patient"), does this only look for the sheet named "New Patient" or does it change to all the new patient names. Each tab will have an actual patient name "LastName, FirstName" and there will be around 100 or so tabs. Will this macro pull these results for every tab with a patients name? If not can I make it that way and exclude say the tabs with "New Patient Template", "Data" & "Summary Report"? Again, I REALLY appreciate you taking the time to help out a "NEWBIE"!

**Leith Ross** · 12-31-2008, 01:34 PM

Hello joebelou,

The macro doesn't place the results on the worksheet. The results are held in two variables in the macro: Visit1, and Visit2 both of which are dates. If you tell me the worksheet name and the cells where the results go, I will add that to the macro for you.

Sincerely,
Leith Ross

**joebelou** · 12-31-2008, 01:58 PM

I've attached the workbook to this new thread...The sheet/tab is named "1st - 15th Summary Report" & "16th - 31st Summary Report". The data needs to go on each of the forms according to the dates. The result headings are listed in A2:K2 for both sheets (1-15 & 16-31). The results will need to be placed in A3:K3 & A3:K3 (1-15 & 16-31). Again, this will need to gather this information for all the tabs with patient names (ie. Brown, John & Smith, John) and there may be 100 tabs or so. Thanks again!

**Leith Ross** · 12-31-2008, 02:06 PM

Hello joebelou,

I am glad you sent the updated workbook, because I wasn't following you about the information going to A2:K2 on sheet "1-15" and "16-31". I will change the macro to exclude the sheets named in your previous post and examine the remainder.

Sincerely,
Leith Ross

**Leith Ross** · 12-31-2008, 02:26 PM

Hello joebelou,

There are a few headings I don't understand on the summary sheets. You use RN, LPN, HHA, SW, and SC. The RN and LPN appear on the template, but where are the other 3? Do you need the first date for each of these, or only log the one that was there on the first visit day?

Sincerely,
Leith Ross

**joebelou** · 12-31-2008, 04:50 PM

Leith, sorry for leaving that information out. I forgot they are different on the template and the summary. All the headings are from the Disipline field on the template F14:F20 (all the fields are the same that have the heading discipline they are pulled from a list on the data sheet with the same heading). Here is the breakdown:
Template Sheets = Summary Sheets
RN = RN
LPN = LPN
STNA = HHA
Social Worker = SW
Chaplain = SC
Yes I need the first visit date for each one (RN, LPN, STNA, Social Worker & Chaplain) by patient sheet. Hope this makes more sense. Thanks!

**Leith Ross** · 01-01-2009, 12:17 AM

Hello joebelou,

Happy New Year! The macro will create summaries for all sheets except the following: Data, Patient Template, 1st-15th Summary, and 16th-31st Summary. The first visit date for each discipline and the total number of visits is logged according to the visit date: 1st through 15th or 16th through the 31st.

Summarize Macro

Private Sub FindFirstVisits(ByRef Wks As Worksheet)

  Dim CurMonth As Integer
  Dim NextRow1 As Long
  Dim NextRow2 As Long
  Dim Rng As Range
  Dim Sum1Wks As Worksheet
  Dim Sum2Wks As Worksheet
  Dim VisitDate As Date
  Dim Visits1(1 To 7, 1) As Long
  Dim Visits2(1 To 7, 1) As Long
  Dim Weeks(1 To 5) As String
  
    Set Sum1Wks = Worksheets("1st - 15th Summary Report")
      With Sum1Wks
        NextRow1 = .Cells(Rows.Count, "A").End(xlUp).Row
        NextRow1 = IIf(NextRow1 < 3, 3, NextRow1 + 1)
      End With
    Set Sum2Wks = Worksheets("16th - 31st Summary Report")
      With Sum1Wks
        NextRow2 = .Cells(Rows.Count, "A").End(xlUp).Row
        NextRow2 = IIf(NextRow2 < 3, 3, NextRow2 + 1)
      End With
    
    CurMonth = Month(Wks.Range("F10"))
    
     'Define the ranges for each week's data
      Weeks(1) = "F14:Z20"
      Weeks(2) = "F35:Z41"
      Weeks(3) = "F56:Z62"
      Weeks(4) = "F77:Z83"
      Weeks(5) = "F98:Z104"
        
       'Search each week
        For I = 1 To 5
         'Define the week data table
          Set Rng = Wks.Range(Weeks(I))
         'Refine the week data table - use the # column
          With Rng
            Set Rng = Union(.Columns(2), .Columns(5), .Columns(8), _
                            .Columns(11), .Columns(14), .Columns(17), _
                            .Columns(20))
          End With
            For Each Cell In Rng
             'Check that the cell is not a formula, empty, or a symbol
              If Cell.Text Like "[A-Za-z0-9]*" Then
                 R = Rng.Row - 2
                 C = Cell.Column
                 VisitDate = Wks.Cells(R, C).MergeArea.Cells(1, 1).Value
                   If Month(VisitDate) = CurMonth Then
                     'Cell value is a number key for the discipline
                      Select Case Day(VisitDate)
                        Case 1 To 15
                         'Save the first visit date for this discipline
                          If Visits1(Cell.Value, 0) = 0 Then
                             Visits1(Cell.Value, 0) = CLng(VisitDate)
                          End If
                         'Increment visit count for this discipline
                          Visits1(Cell.Value, 1) = Visits1(Cell.Value, 1) + 1
                        Case 16 To 31
                         'Save the first visit date for this discipline
                          If Visits2(Cell.Value, 0) = 0 Then
                             Visits2(Cell.Value, 0) = CLng(VisitDate)
                          End If
                         'Increment visit count for this discipline
                          Visits2(Cell.Value, 1) = Visits2(Cell.Value, 1) + 1
                      End Select
                   End If
              End If
            Next Cell
        Next I
   
     'Copy the visits and totals to the summary sheets
      Sum1Wks.Cells(NextRow1, "A") = Wks.Name
      Sum2Wks.Cells(NextRow1, "A") = Wks.Name

       For C = 2 To 10 Step 2
         I = C \ 2
           If Visits1(I, 0) = 0 Then
             Sum1Wks.Cells(NextRow1, C) = ""
           Else
             Sum1Wks.Cells(NextRow1, C) = Visits1(I, 0)
           End If
         Sum1Wks.Cells(NextRow1, C + 1) = Visits1(I, 1)
           If Visits2(I, 0) = 0 Then
             Sum2Wks.Cells(NextRow1, C) = ""
           Else
             Sum2Wks.Cells(NextRow1, C) = Visits2(I, 0)
           End If
         Sum2Wks.Cells(NextRow2, C + 1) = Visits2(I, 1)
       Next C
       
End Sub

Public Sub Summarize()

  Dim Wks As Worksheet
  
    For Each Wks In Worksheets
      Select Case Wks.Name
        Case Is = "Data", "New Patient Template", _
                  "1st - 15th Summary Report", _
                  "16th - 31st Summary Report"
          'Do nothing - Skip these worksheets
        Case Else
          FindFirstVisits Wks
      End Select
    Next Wks
    
End Sub

Sincerely,
Leith Ross

**joebelou** · 01-01-2009, 04:40 PM

Happy New Year! Thanks so much for all your help, this thing is AWESOME! There is one thing that I've just been informed of and I'm trying to figure out how to modify the code you've helped me with but am having problems. On the summary report the first visit date and the total visits can't include any of the visits that were "Attempted" & "Refused". These values are in the "Type of Visit" field. Is there an easy line I can add to exclude these or is this a major re-write? I really do thank you for all the help you have provided!

joebelou

**Leith Ross** · 01-01-2009, 04:53 PM

Hello joebelou,

I will look at the worksheet and modify the macro accordingly and post the modifications (workbook and macro).

Sincerely,
Leith Ross

**Leith Ross** · 01-01-2009, 05:33 PM

Hello joebelou,

I made the change to not count visits that are flagged as either "Attempted" or "Refused". Let me know how well this runs with the actual files.

Updated Macros

Private Sub FindFirstVisits(ByRef Wks As Worksheet)

  Dim C As Long
  Dim Cell As Range
  Dim CurMonth As Integer
  Dim I As Integer
  Dim NextRow1 As Long
  Dim NextRow2 As Long
  Dim R As Long
  Dim Rng As Range
  Dim Sum1Wks As Worksheet
  Dim Sum2Wks As Worksheet
  Dim VisitDate As Date
  Dim Visits1(1 To 7, 1) As Long
  Dim Visits2(1 To 7, 1) As Long
  Dim VisitType As String
  Dim Weeks(1 To 5) As String
  
   'Assign worksheets to the object variables
    Set Sum1Wks = Worksheets("1st - 15th Summary Report")
     'Determine the next free row on the summary sheet
      With Sum1Wks
        NextRow1 = .Cells(Rows.Count, "A").End(xlUp).Row
        NextRow1 = IIf(NextRow1 < 3, 3, NextRow1 + 1)
      End With
    Set Sum2Wks = Worksheets("16th - 31st Summary Report")
     'Determine the next free row on the summary sheet
      With Sum1Wks
        NextRow2 = .Cells(Rows.Count, "A").End(xlUp).Row
        NextRow2 = IIf(NextRow2 < 3, 3, NextRow2 + 1)
      End With
    
   'Get the month as a number from 1 to 12
    CurMonth = Month(Wks.Range("F10"))
    
     'Define the ranges for each week's data
      Weeks(1) = "F14:Z20"
      Weeks(2) = "F35:Z41"
      Weeks(3) = "F56:Z62"
      Weeks(4) = "F77:Z83"
      Weeks(5) = "F98:Z104"
        
       'Search each week
        For I = 1 To 5
         'Define the week data table
          Set Rng = Wks.Range(Weeks(I))
         'Refine the week data table - use the # column
          With Rng
            Set Rng = Union(.Columns(2), .Columns(5), .Columns(8), _
                            .Columns(11), .Columns(14), .Columns(17), _
                            .Columns(20))
          End With
            For Each Cell In Rng
             'Check that the cell is not a formula, empty, or a symbol
              If Cell.Text Like "[A-Za-z0-9]*" Then
                 R = Rng.Row - 2
                 C = Cell.Column
                 VisitType = Cell.Offset(0, 1).Text
                 VisitDate = Wks.Cells(R, C).MergeArea.Cells(1, 1).Value
                'Check the Visit Type - Don't count Attempted or Refused
                 If VisitType <> "Attempted" And VisitType <> "Refused" Then
                   If Month(VisitDate) = CurMonth Then
                     'Cell value is a number key for the discipline
                      Select Case Day(VisitDate)
                        Case 1 To 15
                         'Save the first visit date for this discipline
                          If Visits1(Cell.Value, 0) = 0 Then
                             Visits1(Cell.Value, 0) = CLng(VisitDate)
                          End If
                         'Increment visit count for this discipline
                          Visits1(Cell.Value, 1) = Visits1(Cell.Value, 1) + 1
                        Case 16 To 31
                         'Save the first visit date for this discipline
                          If Visits2(Cell.Value, 0) = 0 Then
                             Visits2(Cell.Value, 0) = CLng(VisitDate)
                          End If
                         'Increment visit count for this discipline
                          Visits2(Cell.Value, 1) = Visits2(Cell.Value, 1) + 1
                      End Select
                   End If   'Month test
                 End If    'Visit type
              End If      'Cell validation
            Next Cell    'Next Discipline number
        Next I          'Next Week
    
     'Copy the visits and totals to the summary sheets
      Sum1Wks.Cells(NextRow1, "A") = Wks.Name
      Sum2Wks.Cells(NextRow1, "A") = Wks.Name

       For C = 2 To 10 Step 2
         I = C \ 2
           If Visits1(I, 0) = 0 Then
             Sum1Wks.Cells(NextRow1, C) = ""
           Else
             Sum1Wks.Cells(NextRow1, C) = Visits1(I, 0)
           End If
         Sum1Wks.Cells(NextRow1, C + 1) = Visits1(I, 1)
           If Visits2(I, 0) = 0 Then
             Sum2Wks.Cells(NextRow2, C) = ""
           Else
             Sum2Wks.Cells(NextRow2, C) = Visits2(I, 0)
           End If
         Sum2Wks.Cells(NextRow2, C + 1) = Visits2(I, 1)
       Next C
       
End Sub

Public Sub Summarize()

  Dim Wks As Worksheet
  
    For Each Wks In Worksheets
      Select Case Wks.Name
        Case Is = "Data", "New Patient Template", _
                  "1st - 15th Summary Report", _
                  "16th - 31st Summary Report"
          'Do nothing - Skip these worksheets
        Case Else
          FindFirstVisits Wks
      End Select
    Next Wks
    
End Sub

Sincerely,
Leith Ross