Trying to create nested lists of text data based on test group and questionnaire response, then return the total number of each type of response

Question

My macro accurately creates 2 lists of numerical data based on which group (control or exposed) a subject is in.

Dim Subjects As Integer
Subjects = Sheets("Participant Info").Range("C4:C39").Count
        
Dim group As String, Rspns As Long
Dim r As Long, i As Long, j As Long
       
Dim arC, arE
ReDim arC(1 To Subjects)
ReDim arE(1 To Subjects)

With Sheets("Participant Info")
    For r = 4 To Subjects + 3
        group = .Cells(r, "E").Value
        Rspns = .Cells(r, "C").Value
        If group = "Control" Then
             i = i + 1
             arC(i) = Rspns
        End If
        If group = "Exposed" Then
             j = j + 1
             arE(j) = Rspns
        End If
    Next
End With
Sheets("PRISM-Ready").Activate
For i = 1 To i
    Sheets("PRISM-Ready").Cells(i + 2, 1).Value = arC(i)
Next
For j = 1 To j
    Sheets("PRISM-Ready").Cells(j + 2, 2).Value = arE(j)
Next

Now I am trying to create 2 lists of subject responses (control vs exposed) but this time with TEXT data (responses are either "NA", "Never", "Rarely", "Sometimes" and "Frequently"). Then I want to further break down this down with the total number of each response from each group. Below should give me the number "7" in cell "F163" on Sheets "PRISM-Ready" meaning in the control group, the answer "NA" was given 7 times in a survey.

Dim NAcount As String, Ncount As String, Rcount As String, Scount As String, Fcount As String
Dim arNA, arN, arR, arS, arF

Dim CHCars As String, Cars As String, Cars1 As String
    With Sheets("Participant Info")
        For r = 4 To Subjects + 3
            group = .Cells(r, "E").Value
            CHCars = .Cells(r, "F").Value
            If group = "Control" Then
                Cars = Cars + 1
                arC(Cars) = CHCars
            End If
            If group = "Exposed" Then
                Cars1 = Cars1 + 1
                arE(Cars1) = CHCars
            End If
        Next
    End With
    For **Cars** = 1 To UBound(arC)
         If arC(Cars) = "NA" Then
            NAcount = NAcount + 1
            arNA(NAcount) = CHCars
         End If
    Next
    Sheets("PRISM-Ready").Activate
        Sheets("PRISM-Ready").Cells("F163").Value = arNA(NAcount).Count

When I run this code I get "Compile error: Type mismatch", and it highlights Cars in the code (I only added the "**" to show where the error is occuring). I'm pretty sure it has something to do with my use of Strings, or Variants, Long, etc. Any help will be appreciated.

So far I have tried changing Long to String or variant. Both give me Error 13: Type mismatch.

This looks odd arNA(NAcount) = CHCars since CHCars is the last value assigned in the For r = 4 To Subjects + 3 loop. Also why arNA(NAcount).Count rather than just NAcount ? . Also Rspns = .Cells(r, "C").Value but then arC(i) = age ?. I recommend you add Option Explicit as first code line. — CDP1802
– CDP1802, Commented May 15 at 19:42

Tim Williams · Accepted Answer · 2025-05-16 06:05:06Z

Here's a more flexible way of looking at this type of task - using dictionaries instead of arrays:

Sub Tester()
    
    Dim data As Object, wsData As Worksheet, r As Long, grp As String, resp As String
    Dim rngOut As Range, kGrp, kResp, numSubjects As Long, rawVals As Variant
    
    Set wsData = ThisWorkbook.Worksheets("Participant Info")
    Set data = dict()
    
    numSubjects = 28 'for example
    
    'get all data as a 2D array (faster than reading cell-by-cell)
    rawVals = wsData.Range("E4:F4").Resize(numSubjects).Value
    
    For r = 1 To UBound(rawVals, 1) 'loop over the array
        grp = ValueOrDefault(rawVals(r, 1), "[no group]")      'Col E
        resp = ValueOrDefault(rawVals(r, 2), "[no response]")  'Col F
        
        If Not data.Exists(grp) Then 'new treatment group?
            Set data(grp) = dict() 'add a dictionary to track responses for the group
            'Next line ensures responses with zero counts still show up:
            '   comment out if not needed
            LoadKeys data(grp), Array("NA", "Never", "Rarely", "Sometimes", "Frequently")
        End If 'new group
        data(grp)(resp) = data(grp)(resp) + 1 'increment group:response count
    Next r
    
    'display the results (in this case on the same sheet)
    wsData.Range("H4").Resize(1, 3).Value = Array("Group", "Response", "Count")
    Set rngOut = wsData.Range("H5")
    For Each kGrp In data                   'Group name
        For Each kResp In data(kGrp).Keys   'Response
            rngOut.Resize(1, 3).Value = Array(kGrp, kResp, data(kGrp)(kResp))
            Set rngOut = rngOut.Offset(1) 'next listing row
        Next kResp
    Next kGrp
    
    'you can directly access counts like
    Debug.Print "Control>Rarely", data("Control")("Rarely")
    Debug.Print "Exposed>Never", data("Exposed")("Never")
End Sub

'Return `v` if not zero-length, otherwise return `def`
Function ValueOrDefault(v, def)
    ValueOrDefault = IIf(Len(v) = 0, def, v)
End Function

'Load all values from `arrKeys` as keys in dictionary `dict`
Sub LoadKeys(ByRef dict As Object, arrKeys As Variant)
    Dim el
    For Each el In arrKeys
        dict(CStr(el)) = 0 'set initial count for each value
    Next el
End Sub

'Return a case-insensitive scripting dictionary object
Function dict() As Object
    Dim d As Object
    Set d = CreateObject("scripting.dictionary")
    d.CompareMode = 1 'case-insensitive
    Set dict = d
End Function

Test data and output:

You could likely also use COUNTIFS for this and skip the VBA. Or use a Pivot Table.

Collectives™ on Stack Overflow

Trying to create nested lists of text data based on test group and questionnaire response, then return the total number of each type of response

1 Answer 1

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Related