CODEWITHSUNDEEP
vbaexcel
Nick
Nick

Reputation: 372

Compare and get greatest date and related fields

I am very new to using VBA for Excel and need to develop some code that will retrieve a person's greatest Exam dates and related fields (Exam date, Exam Check Date, Exam Induration) and output to another tab called EXAMCI.

Because of data integrity issues with the date input file, In some instances Exam Date (Column D) will be greater than 2nd Exam Date (Column H), and vice versa; there will be some instances when the 2nd Exam Date (Column H) is greater than the first Exam date (Column D).

Here is some sample data from the file (Columns are A - K, Left to Right):

Userid  Employee Name   DOB             Exam Date       Exam Check Date Exam Induration Exam Negative   2nd Exam Date   2nd Exam Check Date 2nd Exam Induration 2nd Exam Negative
1234    John Smith      1/1/01          5/22/17         5/24/17         0               Yes             12/6/17         12/8/17             0                   Yes
6481    Jill Son        2/2/02          11/18/15        11/21/15        0               Yes             2/23/17         2/26/17             0                   Yes
3271    Cathy John      3/3/03          7/17/17         7/19/17         0               Yes             6/15/16         6/17/16             0                   Yes

In the above example data you can see that the first Exam Date is greater than then 2nd Exam Date for John Smith and Cathy John, however the 2nd Exam Date is greater than the first Exam Date for Jill Son.

What I want the program to do is check each row to see whether Exam Date or 2nd Exam Date is the greatest (of the two) and then output Userid, Employee Name, DOB, and either the (Exam Date, Check Date, and Exam Induration) or the (2nd Exam Date, 2nd Exam Check Date, and 2nd Exam Induration) -- depending on which associated date was greater.

So in the example John Smith and Jill Son, I would want to output on the tab EXAMCI the following data (column labels can remain the same, e.g. no need to distinguish between Exam Date and 2nd Exam Date:)

Userid     Employee Name    DOB       Exam Date     Exam Check Date    Exam Induration
1234       John Smith       1/1/01    5/22/17       5/24/17            0
3271       Jill Son         3/3/03    2/23/17       2/26/17            0

Please let me know if the requirement is not clear, thanks for any feedback!

EDIT:

Here is the code I am attempting to add into this already existing program, function is called Examdate:

Public lstrow As Long, strDate As Variant, stredate As Variant

Sub importbuild()

Application.ScreenUpdating = False

'Define last row of exported data
lstrow = Worksheets("Data").Range("G" & Rows.Count).End(xlUp).Row

Worksheets("Data").Cells.Replace what:="=", Replacement:="", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False

'Run function to build import file for Hepatitis Immunizations
Call HepLoad("O", "P", "HB1")
Call HepLoad("Q", "R", "HB2")
Call HepLoad("S", "T", "HB3")
Call HepLoad("U", "V", "HB1")
Call HepLoad("W", "X", "HB2")
Call HepLoad("Y", "NA", "HB3")
'Run function for Hepatitis Series Completed
Call HepSeries("Z", "AA")
'Run function for Titers
Call Titer("AB", "AC", "HT")
Call Titer("AD", "AE", "RT")
Call Titer("AF", "AG", "UT")
Call Titer("AH", "AI", "VT")
'Run functions for Varicella Immunizations
Call DateOnlyLoad("AJ", "AK", "VAR1")
Call DateOnlyLoad("AL", "NA", "VAR2")
'Run function for Tetanus Immunizations
Call TetanusLoad("AM", "AN")
'Run function for MMR Immunizations
Call DateOnlyLoad("AO", "AP", "MMR1")
Call DateOnlyLoad("AQ", "NA", "MMR2")
'Call BCGLoad("BA", "NA", "BCG")
Call Examdate

Application.ScreenUpdating = True

End Sub

(Other functions omitted)

Function Examdate()

Dim Exam_1_Date As Variant
Dim Exam_2_Date As Variant
Dim i As Long, j As Long

j = Worksheets("PPDCI").Range("A" & Rows.Count).End(xlUp).Row + 1
For i = 2 To lstrow

Exam_1_Date = Worksheets("Data").Range("AW" & i)
Exam_2_Date = Worksheets("Data").Range("BA" & i)

If Exam_1_Date > Exam_2_Date Then
   Worksheets("PPDCI").Range("A" & j & ":C" & j).Value = 
Worksheets("Data").Range("F" & i & ":H" & i).Value
   Worksheets("PPDCI").Range("F" & j).Value = Exam_1_Date
Else
    If Exam_1_Date < Exam_2_Date Then
    Worksheets("PPDCI").Range("A" & j & ":C" & j).Value = 
Worksheets("Data").Range("F" & i & ":H" & i).Value
    Worksheets("PPDCI").Range("F" & j).Value = Exam_2_Date
    End If
Worksheets("PPDCI").Range("F" & j).Value = "CAN NOT DETERMINE"
End If

Next i

End Function

When I attempt to run the macro, I get an "Object required" error. Do I need to specify the variables up where the function is being called? Also does the logic appear to be correct?

Upvotes: 0

Views: 56

Answers (1)

Pᴇʜ
Pᴇʜ

Reputation: 57683

use an If … ElseIf … Else … End If statement and increase j.

For i = 2 To lstrow
    Exam_1_Date = Worksheets("Data").Range("AW" & i)
    Exam_2_Date = Worksheets("Data").Range("BA" & i)

    If Exam_1_Date > Exam_2_Date Then
        Worksheets("PPDCI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("F" & i & ":H" & i).Value
        Worksheets("PPDCI").Range("F" & j).Value = Exam_1_Date
    ElseIf Exam_1_Date < Exam_2_Date Then
        Worksheets("PPDCI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("F" & i & ":H" & i).Value
        Worksheets("PPDCI").Range("F" & j).Value = Exam_2_Date
    Else
        Worksheets("PPDCI").Range("F" & j).Value = "CAN NOT DETERMINE"
    End If
    j = j + 1
Next i

Upvotes: 1

Related Questions