Search code examples
excelvbaloopsiterationdate-range

VBA: How can I fill in cells in one column based on the collective information of iterative ranges?

I need to fill in Col H (see red text in image for an example) as follows:

  1. There are 3 subjects listed (separated by grey background) (Col C for number)
  2. Each subject has multiple data points (one per row-Col D for data point "name")
  3. (not shown) each subject multiple data points is run on multiple tests and sorted by test, subject, timepoint. (See Col E for Test), which means each "unifying ID"/"Subject ID" is used more than once. This data should be considered separately (for example, subject 8 Adiponectin results should not be compared with subject 8 Areg data)
  4. Some of the data is not detected by the test and is marked in both Col J ("<LLOQ") and Col I ("Yes" for <LLOQ aka not detected).
  5. I need help designing a program that answers if "all samples from this subject (and test) are below LLOQ?". Thus the program needs to detect that each subject's data must be viewed in a chunk fill out Col H "All Samples below LLOQ?" before moving on to the next subject. If there are no <LLOQ samples in the range, then each cell in Col H will be "No". If there are some samples <LLOQ and some samples that are NOT <LLOQ, then each cell in Col H within the range will be "No" (see grey subject). However, if All samples for a subject are <LLOQ, then the values in H must be "Yes" for all cells within the range.

Raw Data

In another Sub() I figured out how to reset values for each new subject using "C01D01.00" as a reset cue. This works to fill in data that is not reliant on the cells in a range (such as "Is the Baseline below LLOQ?" in col G. But I cannot figure out how to "set" a range, read through the range, identify if any cells are "no" in Col I and then return "no" in Col H (or "yes" in Col H if there are no "no" in Col I with in the range, and then move onto the next "range"). Ideas?

See below for how I programmed Col G.


Sub BaselineBelowLLOQ()

    Sheets("Cyt-Data").Activate
    Dim NewSubject As String
    Dim SubjectBL As String
    Dim BaselineRow As Integer

    For i = 2 To 1000000
        If Sheets("Cyt-Data").Cells(i, 2).Value = "" Then
            Exit For
        End If
        
        NewSubject = Cells(i, 3).Value
        
        If Not SubjectBL = NewSubject And Cells(i, 4).Value = "C01D01.00" Then
            SubjectBL = NewSubject
            BaselineRow = i
        ElseIf Not SubjectBL = NewSubject And Not Cells(i, 4).Value = "C01D01.00" Then
            SubjectBL = ""
        End If
    
        
        If Not SubjectBL = "" Then
            If Cells(BaselineRow, 9).Value = "Yes" Then
                Cells(i, 7).Value = "Yes"
            Else
                Cells(i, 7).Value = "No"
            End If
        End If
    Next i

End Sub
Solution

  • Something like this should work:

    Sub BaselineBelowLLOQ()

    Dim ws As Worksheet, i As Long, dict As Object, k As String
    Dim subjId, testName, num1 As Long, num2 As Long
    
    Set dict = CreateObject("scripting.dictionary")
    Set ws = ThisWorkbook.Worksheets("Cyt-Data") 'or ActiveWorkbook...
    
    For i = 2 To ws.Cells(Rows.Count, "B").End(xlUp).Row
        
        subjId = ws.Cells(i, "C").Value
        testName = ws.Cells(i, "E").Value
        k = subjId & "<>" & testName 'SubjectId<>TestName combination
        If Not dict.exists(k) Then   'new combination?
            
            'count all rows for this combo
            num1 = Application.CountIfs(ws.Columns("C"), subjId, _
                                        ws.Columns("E"), testName)
            'count rows for this combo with "Yes" in Col I
            num2 = Application.CountIfs(ws.Columns("C"), subjId, _
                                        ws.Columns("E"), testName, _
                                        ws.Columns("I"), "Yes")
            
            dict.Add k, IIf(num1 = num2, "Yes", "No") 'compare counts for this combo
                                                      'and store the Yes/No outcome
        End If
        'tag the row using the value we already figured out
        ws.Cells(i, "H").Value = dict(k)
    Next i

End Sub