Grab value from column of same record using a different column

[thr33xx]

Hello all,

I am trying to figure out how to code this loop efficiently and effectively, and below is what I've come up with, but I'm not exactly sure how to execute it.

The code below is performing the function of taking the remainder of a calculated value (MOD), and adding the remainder to existing values (updating). This is a loop which continues to execute until the remainder is less than 1. Below in red, is where I'm having trouble. I would like to set the WHERE statement to search for the provided criteria (study month of date first subject enrolled + 1 month), but grab the value of another column in that same record (reporting month). The reporting month and study month values are both located in the same table. Hopefully that makes sense.

Eventually, what I would like to do, is set "s" (in orange) as the value of the reporting month, and before the loop ends set "s = s+1" so that the loop executes on the next and correct record, and not the same record. Now before people jump on a alternative solution, my reasoning for doing this is because I do not wish to cycle through months 1-12. I have reporting month setup as incremental 1 - infinity. This makes for less coding on my end.

Below is my current code, where I have highlighted in red where I'm having issues.

Any help or suggestions would be appreciated. Thank you and Happy Holidays!

Dim r As Integer 'r is equal to the remainder value of total target enrollment if not divisible by whole numbers
[COLOR="DarkOrange"][B]Dim s As Integer 's is equal to the reporting month[/B][/COLOR]

MsgBox "Start"
If Me.add_cbo_calculate = 1 And Me.Add_Study_Start_Enrolled < Me.Add_Tot_Target_Enroll And Me.Add_Dt_First_Subject_Enrolled > Me.Add_St_Dt_Metrics Then
    r = (Me.Add_Tot_Target_Enroll - Me.Add_Study_Start_Enrolled) Mod (DCount("[Month_Into_Recruitment]", "dbo_monthly_expectations", "[Study_ID] = '" & Me.Add_Study_ID & "' AND [MONTH_INTO_RECRUITMENT] > 1"))
    MsgBox r
    Do Until r < 1
        'If r > 0 Then
        sql6 = "Update dbo_Monthly_Expectations "
        sql6 = sql6 & "Set Exp_Recruitment= ((" & Me.Add_Tot_Target_Enroll & " - " & Me.Add_Study_Start_Enrolled & ")/("
        sql6 = sql6 & DCount("[Month_Into_Recruitment]", "dbo_monthly_expectations", "[Study_ID] = '" & Me.Add_Study_ID & "' AND [MONTH_INTO_RECRUITMENT] > 1 ")
        sql6 = sql6 & ")) + (1)"
        sql6 = sql6 & " [B][COLOR="Red"]Where study_id = '" & Me.Add_Study_ID & "' AND Study_Month = " & Month(DateAdd("m", 1, Me.Add_Dt_First_Subject_Enrolled)) & " AND Study_Year = " & Year(DateAdd("m", 1, Me.Add_Dt_First_Subject_Enrolled))[/COLOR][/B]
        MsgBox sql6
        cn.Execute sql6
        r = r - 1
        MsgBox r
        MsgBox "End"
        Loop
    End If
    Exit Sub

 

[Guus2005]

what does sql6 look like? before executing?

 

[thr33xx]

Here's what the code looks like.

Private Sub Add_New_Study_Click()
Dim cn As ADODB.Connection
Set cn = CurrentProject.AccessConnection
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.ActiveConnection = cn
Dim sql As String
Dim sql2 As String
Dim var_item As Variant
Dim ctl As Control
Dim i As Integer
Dim sql3 As String
i = 1
Dim strFrmName As String
Dim sql4 As String
Dim sql5 As String
Dim Monthstoadd As Integer
Dim Numtoenroll As Integer
Dim x As Integer
Dim sql6 As String
Dim sql7 As String
Dim sql8 As String
Dim sql9 As String
Dim sql10 As String

'Get_User_Name.Get_User_Name

'Checks to validate all required fields are complete
    'Validates that the study id field is complete
    If IsNull(Me.Add_Study_ID) Or Me.Add_Study_ID = "" Then
         If MsgBox("A Study Short Title must be assigned", vbRetryCancel) = vbRetry Then
            Me.Add_Study_ID.SetFocus
            Exit Sub
         Else
            Me.Add_Study_ID.SetFocus
            Exit Sub
         End If
    End If
    'Validates that the coordinator last name is complete
    If IsNull(Me.Add_Coor_ID_Last) Or Me.Add_Coor_ID_Last = "" Then
         If MsgBox("A Coordinator Last Name must be assigned", vbRetryCancel) = vbRetry Then
            Me.Add_Coor_ID_Last.SetFocus
            Exit Sub
         Else
            Me.Add_Coor_ID_Last.SetFocus
            Exit Sub
         End If
    End If
    'Validates that the coordinator first name is complete
    If IsNull(Me.Add_Coor_ID_First) Or Me.Add_Coor_ID_First = "" Then
         If MsgBox("A Coordinator First Name must be assigned", vbRetryCancel) = vbRetry Then
            Me.Add_Coor_ID_First.SetFocus
            Exit Sub
         Else
            Me.Add_Coor_ID_First.SetFocus
            Exit Sub
         End If
    End If
    
'inserts study setup values into sql server
sql = "insert into dbo_Setup "
sql = sql & "(study_id, project_title, coor_id_last, coor_id_first, study_phase, dt_first_subject_enrolled, dt_exp_enroll_complete, exp_num_mon_enroll, recruiting, dt_irb_approval, dt_go_live, pi, calculate, tot_target_enroll, comments, Coor_Ph, Coor_Email, Clinic_Area, Study_Phase_Other, Recruitment_Started, Study_Months_Elapsed, Study_Start_Enrolled, Study_Start_Screen_Failures, Study_Start_Early_Withdrawals, Study_Start_Screened, St_Dt_Metrics, Months_Followed) "
sql = sql & "Values "
sql = sql & "('" & Me.Add_Study_ID & "'," _
    & IIf(IsNull(Me.add_project_title), "null", "'" & Me.add_project_title & "'") & ", " & IIf(IsNull(Me.Add_Coor_ID_Last), "NULL", "'" & Me.Add_Coor_ID_Last & "'") & ", " _
    & IIf(IsNull(Me.Add_Coor_ID_First), "NULL", "'" & Me.Add_Coor_ID_First & "'") & ", " _
    & IIf(IsNull(Me.Add_Study_Phase), "NULL", "'" & Me.Add_Study_Phase & "'") & ", " _
    & IIf(IsNull(Me.Add_Dt_First_Subject_Enrolled), "NULL", "'" & Me.Add_Dt_First_Subject_Enrolled & "'") & ", " _
    & IIf(IsNull(Me.Add_Dt_Exp_Enroll_Complete), "null", "'" & Me.Add_Dt_Exp_Enroll_Complete & "'") & ", " _
    & IIf(IsNull(Me.Add_Exp_Num_Mon_Enroll), "null", "'" & Me.Add_Exp_Num_Mon_Enroll & "'") & ", " _
    & IIf(IsNull(Me.Add_Recruiting), "null", "'" & Me.Add_Recruiting & "'") & ", " _
    & IIf(IsNull(Me.Add_Dt_IRB_Approval), "null", "'" & Me.Add_Dt_IRB_Approval & "'") & ", " _
    & IIf(IsNull(Me.Add_Dt_Go_Live), "null", "'" & Me.Add_Dt_Go_Live & "'") & ", " _
    & IIf(IsNull(Me.Add_PI), "null", "'" & Me.Add_PI & "'") & ", " _
    & IIf(IsNull(Me.add_cbo_calculate), "null", "'" & Me.add_cbo_calculate & "'") & ", " _
    & IIf(IsNull(Me.Add_Tot_Target_Enroll), "null", "'" & Me.Add_Tot_Target_Enroll & "'") & ", " _
    & IIf(IsNull(Me.Add_Setup_Comments), "null", "'" & Me.Add_Setup_Comments & "'") & ", " _
    & IIf(IsNull(Me.Add_Coor_Ph), "null", "'" & Me.Add_Coor_Ph & "'") & ", " _
    & IIf(IsNull(Me.Add_Coor_Email), "null", "'" & Me.Add_Coor_Email & "'") & ", " _
    & IIf(IsNull(Me.Add_Clinic_Area), "null", "'" & Me.Add_Clinic_Area & "'") & ", " _
    & IIf(IsNull(Me.Add_Study_Phase_Other), "null", "'" & Me.Add_Study_Phase_Other & "'") & ", " _
    & IIf(IsNull(Me.Add_Recruitment_Started), "null", "'" & Me.Add_Recruitment_Started & "'") & ", " _
    & IIf(IsNull(Me.Add_Study_Months_Elapsed), "null", "'" & Me.Add_Study_Months_Elapsed & "'") & ", " _
    & IIf(IsNull(Me.Add_Study_Start_Enrolled), "null", "'" & Me.Add_Study_Start_Enrolled & "'") & ", " _
    & IIf(IsNull(Me.Add_Study_Start_Screen_Failures), "null", "'" & Me.Add_Study_Start_Screen_Failures & "'") & ", " _
    & IIf(IsNull(Me.Add_Study_Start_Early_Withdrawals), "null", "'" & Me.Add_Study_Start_Early_Withdrawals & "'") & ", " _
    & IIf(IsNull(Me.Add_Study_Start_Screened), "null", "'" & Me.Add_Study_Start_Screened & "'") & ", " _
    & IIf(IsNull(Me.Add_St_Dt_Metrics), "null", "'" & Me.Add_St_Dt_Metrics & "'") & ", " & IIf(IsNull(Me.Add_Months_Followed), "null", "'" & Me.Add_Months_Followed & "'") & ") "
    cn.Execute sql
 
sql10 = "Update dbo_Setup "
sql10 = sql10 & "Set Archive_Study = 0 where Study_ID = '" & Me.Add_Study_ID & "' "
cn.Execute sql10

'add selected facilities to table dbo_study_facilities
  Set ctl = Me.Add_Fac_ID
  For Each var_item In ctl.ItemsSelected
        sql2 = " insert into dbo_study_facilities (study, facility) values ('" & Me.Add_Study_ID & "', '" & ctl.ItemData(var_item) & "') "
        cn.Execute sql2
  Next var_item

'adds in progress study's study id, reporting month, month into recruitment, and exp rectruitment into monthly expectations. Month zero
If Me.Add_Recruitment_Started = "Yes" And Me.Add_Dt_First_Subject_Enrolled > Me.Add_St_Dt_Metrics Then
        sql4 = "insert into dbo_monthly_expectations"
        sql4 = sql4 & "(Study_ID, Reporting_Month, Month_Into_Recruitment, Exp_Recruitment) "
        sql4 = sql4 & "Values ('" & Me.Add_Study_ID & "', " & "0" & ", " & ((Abs(DateDiff("m", [Add_Dt_Exp_Enroll_Complete], [Add_Dt_First_Subject_Enrolled])) + 1) - (Abs(DateDiff("m", [Add_Dt_Exp_Enroll_Complete], [Add_St_Dt_Metrics])) + 1)) & ",  " & "Null) "
    cn.Execute sql4
    ElseIf Me.Add_Recruitment_Started = "Yes" And Me.Add_Dt_First_Subject_Enrolled < Me.Add_St_Dt_Metrics Then
        sql4 = "insert into dbo_monthly_expectations"
        sql4 = sql4 & "(Study_ID, Reporting_Month, Month_Into_Recruitment, Exp_Recruitment) "
        sql4 = sql4 & "Values ('" & Me.Add_Study_ID & "', " & "0" & ", " & ((Abs(DateDiff("m", [Add_Dt_Exp_Enroll_Complete], [Add_Dt_First_Subject_Enrolled])) + 1) - (Abs(DateDiff("m", [Add_Dt_Exp_Enroll_Complete], [Add_St_Dt_Metrics])) + 1)) & ", " & Me.Add_Study_Start_Enrolled & ") "
    cn.Execute sql4
    Else
        End If
    
'Determines # of months to add to monthly expectations
If Me.Add_Recruitment_Started = "Yes" Then
        Monthstoadd = Abs(DateDiff("m", [Add_Dt_Exp_Enroll_Complete], [Add_St_Dt_Metrics])) + 1
        Numtoenroll = (Me.Add_Tot_Target_Enroll - Me.Add_Study_Start_Enrolled)
    ElseIf Not IsNull(Me.Add_Tot_Target_Enroll) And IsNull(Me.Add_Recruitment_Started) Or Me.Add_Recruitment_Started = "" Then
            Monthstoadd = Abs(DateDiff("m", [Add_Dt_Exp_Enroll_Complete], [Add_St_Dt_Metrics])) + 1
            Numtoenroll = Me.Add_Tot_Target_Enroll
    ElseIf Me.Add_Recruitment_Started = "No" Then
            Monthstoadd = Abs(DateDiff("m", [Add_Dt_Exp_Enroll_Complete], [Add_St_Dt_Metrics])) + 1
            Numtoenroll = Me.Add_Tot_Target_Enroll
    Else
        End If

'Loop enters study months for the duration of the study
Do While i <= Monthstoadd
    If add_cbo_calculate = 1 And Me.Add_Study_Start_Enrolled > Me.Add_Tot_Target_Enroll Then
        sql3 = "insert into dbo_Monthly_Expectations "
        sql3 = sql3 & "(Study_ID, study_year, Study_Month, Exp_Recruitment, Reporting_Month, Month_Into_Recruitment) "
        sql3 = sql3 & "Values ('" & Me.Add_Study_ID & "', " & Year(DateAdd("m", i - 1, Me.Add_St_Dt_Metrics))
        sql3 = sql3 & ", " & Month(DateAdd("m", i - 1, Me.Add_St_Dt_Metrics)) & ","
        sql3 = sql3 & 0 & ", "
        sql3 = sql3 & IIf(IsNull(DMax("Reporting_Month", "dbo_monthly_expectations", "study_id='" & Me.Add_Study_ID & "'")) = True, 1, DMax("Reporting_Month", "dbo_monthly_expectations", "study_id='" & Me.Add_Study_ID & "'") + 1) & ","
        sql3 = sql3 & IIf(IsNull(DMax("Month_Into_Recruitment", "dbo_monthly_expectations", "study_id='" & Me.Add_Study_ID & "'")) = True, 1, DMax("Month_Into_Recruitment", "dbo_monthly_expectations", "study_id='" & Me.Add_Study_ID & "'") + 1) & ")"
    ElseIf add_cbo_calculate = 1 And Me.Add_Study_Start_Enrolled < Me.Add_Tot_Target_Enroll Then
        sql3 = "insert into dbo_Monthly_Expectations "
        'sql3 = sql3 & "(Study_ID, study_year, Study_Month, Exp_Recruitment, Reporting_Month, Month_Into_Recruitment) "
        sql3 = sql3 & "(Study_ID, study_year, Study_Month, Reporting_Month, Month_Into_Recruitment) "
        sql3 = sql3 & "Values ('" & Me.Add_Study_ID & "', " & Year(DateAdd("m", i - 1, Me.Add_St_Dt_Metrics))
        sql3 = sql3 & ", " & Month(DateAdd("m", i - 1, Me.Add_St_Dt_Metrics)) & ","
        'sql3 = sql3 & -Int(-(Numtoenroll) \ (Monthstoadd)) & ", "
        sql3 = sql3 & IIf(IsNull(DMax("Reporting_Month", "dbo_monthly_expectations", "study_id='" & Me.Add_Study_ID & "'")) = True, 1, DMax("Reporting_Month", "dbo_monthly_expectations", "study_id='" & Me.Add_Study_ID & "'") + 1) & ","
        sql3 = sql3 & IIf(IsNull(DMax("Month_Into_Recruitment", "dbo_monthly_expectations", "study_id='" & Me.Add_Study_ID & "'")) = True, 1, DMax("Month_Into_Recruitment", "dbo_monthly_expectations", "study_id='" & Me.Add_Study_ID & "'") + 1) & ")"
    Else
        sql3 = "insert into dbo_Monthly_Expectations "
        sql3 = sql3 & "(Study_ID, study_year, Study_Month, Reporting_Month, Month_Into_Recruitment) "
        sql3 = sql3 & "Values ('" & Me.Add_Study_ID & "', " & Year(DateAdd("m", i - 1, Me.Add_St_Dt_Metrics)) & ", " & Month(DateAdd("m", i - 1, Me.Add_St_Dt_Metrics)) & ", "
        sql3 = sql3 & IIf(IsNull(DMax("Reporting_Month", "dbo_monthly_expectations", "study_id='" & Me.Add_Study_ID & "'")) = True, 1, DMax("Reporting_Month", "dbo_monthly_expectations", "study_id='" & Me.Add_Study_ID & "'") + 1) & ","
        sql3 = sql3 & IIf(IsNull(DMax("Month_Into_Recruitment", "dbo_monthly_expectations", "study_id='" & Me.Add_Study_ID & "'")) = True, 1, DMax("Month_Into_Recruitment", "dbo_monthly_expectations", "study_id='" & Me.Add_Study_ID & "'") + 1) & ")"
        End If
    cn.Execute sql3
    i = i + 1
    Loop
    
'Modifies monthly expectations where month into recruitment are less than zero and sets expected recruitment to value zero if start date of metrics is prior to date first subject enrolled
If Me.Add_St_Dt_Metrics < Me.Add_Dt_First_Subject_Enrolled Then
        sql5 = "Update dbo_Monthly_Expectations "
        sql5 = sql5 & "Set Exp_Recruitment= 0"
        sql5 = sql5 & " Where study_id = '" & Me.Add_Study_ID & "'"
        cn.Execute sql5
        End If
        
'Updates expected monthly enrollment value for date first subject enrolled to number of subjects enrolled prior to start date of enrollment metrics
If Me.Add_Recruitment_Started = "Yes" And Me.Add_Dt_First_Subject_Enrolled > Me.Add_St_Dt_Metrics Then
    sql9 = "Update dbo_monthly_expectations "
    sql9 = sql9 & "Set Exp_Recruitment = " & Me.Add_Study_Start_Enrolled
    sql9 = sql9 & " Where study_id = '" & Me.Add_Study_ID & "' And Study_Year = " & Year(Me.Add_Dt_First_Subject_Enrolled) & " And Study_Month = " & Month(Me.Add_Dt_First_Subject_Enrolled)
    cn.Execute sql9
    End If

'Modifies monthly expectations where month into recruitment are greater than zero and sets expected recruitment to (total target enrollment - start study enrolled)/(months left to recruit)
If Me.add_cbo_calculate = 1 And Me.Add_St_Dt_Metrics < Me.Add_Dt_First_Subject_Enrolled And IsNull(Me.Add_Study_Start_Enrolled) Then
        sql8 = "Update dbo_monthly_expectations "
        sql8 = sql8 & "Set Exp_Recruitment= (" & Me.Add_Tot_Target_Enroll & ")/("
        sql8 = sql8 & DCount("[Month_Into_Recruitment]", "dbo_monthly_expectations", "[Study_ID] = '" & Me.Add_Study_ID & "' AND [MONTH_INTO_RECRUITMENT] > 1")
        sql8 = sql8 & ")"
        sql8 = sql8 & " Where study_id = '" & Me.Add_Study_ID & "' AND Month_Into_Recruitment > 1"
        cn.Execute sql8
    ElseIf Me.add_cbo_calculate = 1 And Me.Add_St_Dt_Metrics < Me.Add_Dt_First_Subject_Enrolled Then
        sql8 = "Update dbo_monthly_expectations "
        sql8 = sql8 & "Set Exp_Recruitment= (" & Me.Add_Tot_Target_Enroll & " - " & Me.Add_Study_Start_Enrolled & ")/("
        sql8 = sql8 & DCount("[Month_Into_Recruitment]", "dbo_monthly_expectations", "[Study_ID] = '" & Me.Add_Study_ID & "' AND [MONTH_INTO_RECRUITMENT] > 1")
        sql8 = sql8 & ")"
        sql8 = sql8 & " Where study_id = '" & Me.Add_Study_ID & "' AND Month_Into_Recruitment > 1"
        cn.Execute sql8
    ElseIf Me.add_cbo_calculate = 1 Then
        sql8 = "Update dbo_monthly_expectations "
        sql8 = sql8 & "Set Exp_Recruitment = " & -Int(-(Numtoenroll) \ (Monthstoadd))
        sql8 = sql8 & " Where study_id = '" & Me.Add_Study_ID & "' AND Reporting_month > 0"
        cn.Execute sql8
    Else
        End If
        
        
        
        
        
Dim r As Integer 'r is equal to the remainder value of total target enrollment if not divisible by whole numbers
Dim s As Integer 's is equal to the reporting month

MsgBox "Start"
If Me.add_cbo_calculate = 1 And Me.Add_Study_Start_Enrolled < Me.Add_Tot_Target_Enroll And Me.Add_Dt_First_Subject_Enrolled > Me.Add_St_Dt_Metrics Then
    r = (Me.Add_Tot_Target_Enroll - Me.Add_Study_Start_Enrolled) Mod (DCount("[Month_Into_Recruitment]", "dbo_monthly_expectations", "[Study_ID] = '" & Me.Add_Study_ID & "' AND [MONTH_INTO_RECRUITMENT] > 1"))
    MsgBox r
    Do Until r < 1
        'If r > 0 Then
        sql6 = "Update dbo_Monthly_Expectations "
        sql6 = sql6 & "Set Exp_Recruitment= ((" & Me.Add_Tot_Target_Enroll & " - " & Me.Add_Study_Start_Enrolled & ")/("
        sql6 = sql6 & DCount("[Month_Into_Recruitment]", "dbo_monthly_expectations", "[Study_ID] = '" & Me.Add_Study_ID & "' AND [MONTH_INTO_RECRUITMENT] > 1 ")
        sql6 = sql6 & ")) + (1)"
        sql6 = sql6 & " Where Dlookup("Reporting_Month", "dbo_monthly_expectations", "study_id = '" & Me.Add_Study_ID & "' AND Study_Month = " & Month(DateAdd("m", 1, Me.Add_Dt_First_Subject_Enrolled)) & " AND Study_Year = " & Year(DateAdd("m", 1, Me.Add_Dt_First_Subject_Enrolled))")
        'sql6 = sql6 & " Where study_id = '" & Me.Add_Study_ID & "' AND Study_Month = " & Month(DateAdd("m", 1, Me.Add_Dt_First_Subject_Enrolled)) & " AND Study_Year = " & Year(DateAdd("m", 1, Me.Add_Dt_First_Subject_Enrolled))
        MsgBox sql6
        cn.Execute sql6
        r = r - 1
        MsgBox r
        MsgBox "End"
        Loop
    End If
    Exit Sub

 

[Guus2005]

what does sql6 look like? before executing?