I'm trying to code an analysis that will count certain cells in a data set and color code them based on their relative values. I have the counter code finished, but am now trying to get a subprocedure for the coloring to work. I've been able to achieve this in a stand alone sub procedure that has a manually entered range (ie "b2:e44") however, this isn't super useful as I will be applying this code to many datasets that vary in size.
I was able to code into the function a variable range called "datarange" that changes based on the entered datarange, but when I try to call the datarange and max variables into the subprocedure, it doesn't work.
How do I continue using the function variables in the subprocedure?
This is what I have so far:
Function breadthreport(datarange As Range, max As Variant, increase As String)
'counters
Dim cf1 As Variant
cf1 = 0
Dim cf2 As Variant
cf2 = 0
Dim cf3 As Variant
cf3 = 0
Dim cf4 As Variant
cf4 = 0
'cell variables
Dim x As Variant
Dim y As Variant
'no room for improvement
For x = 1 To datarange.Rows.Count Step 2
For y = 1 To datarange.Columns.Count
If datarange(x, y) = datarange(x + 1, y) And datarange(x, y) = max Then
cf1 = cf1 + 1
Else
End If
Next y
Next x
'stagnant cohort
For x = 1 To datarange.Rows.Count Step 2
For y = 1 To datarange.Columns.Count
If datarange(x, y) = datarange(x + 1, y) Then
cf2 = cf2 + 1
Else
End If
Next y
Next x
'worsening cohorts
For x = 1 To datarange.Rows.Count Step 2
For y = 1 To datarange.Columns.Count
If increase = "improvement" Then
If datarange(x, y) > datarange(x + 1, y) Then
cf3 = cf3 + 1
Else
End If
ElseIf increase = "worsening" Then
If datarange(x, y) < datarange(x + 1, y) Then
cf3 = cf3 + 1
Else
End If
Else
End If
Next y
Next x
'success cohorts
For x = 1 To datarange.Rows.Count Step 2
For y = 1 To datarange.Columns.Count
If increase = "improvement" Then
If datarange(x, y) < datarange(x + 1, y) Then
cf4 = cf4 + 1
Else
End If
ElseIf increase = "worsening" Then
If datarange(x, y) > datarange(x + 1, y) Then
cf4 = cf4 + 1
Else
End If
Else
End If
Next y
Next x
'define your array
Dim ret(3, 1) As Variant
Dim labels(3, 0) As String
'insert a sub to color the labels
breadthcolor datarange, max, increase
'labels
ret(0, 0) = "Stagnant Max Cohort"
ret(1, 0) = "Stagnant Cohort"
ret(2, 0) = "Worsening Cohort"
ret(3, 0) = "Success Cohort"
'assign values
ret(0, 1) = cf1
ret(1, 1) = cf2
ret(2, 1) = cf3
ret(3, 1) = cf4
breadthreport = ret
End Function
Sub breadthcolor(subrange As Range, submax As Variant, subincrease As String)
MsgBox "youre in the sub"
'cell variables
Dim x As Variant
Dim y As Variant
'no room for improvement
For x = 1 To subrange.Rows.Count Step 2
For y = 1 To subrange.Columns.Count
For Each cell In subrange
If cell(x, y).Value = cell(x + 1, y).Value Then
cell.Interior.color = vbGreen
Else
End If
Next
Next y
Next x
'the rest of the sub will mirror the counter function but with color changes rather than counters
End Sub
Ideally this can be done using the datarange defined in the function, I'm sharing this code with my team who have no background in coding and will not be able to manually edit the range in the procedure.
