VBA - run a formula which adapts to a range that isn't always the same

Question

If you look at the picture above. The thing I want is to run an formula when the text like 1ST or CUCA or 2ND occurs in column E. I want the formula +countif to run, but in this formula I define the range which is in the example F2:F25, but this depends on how many agents I have. If there is one agent less it needs to adapt the range.

Then I have the next day in this sheet and I need it to do the same thing but again with another range.

Can someone help me?

For the moment I use this but I defined the range but the range can change and I don't want to modify the code constantly

Sub Runcode()

    Dim strFormulas(1 To 6) As Variant    

    Range("F26").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R2C1,R[-24]C:R[-1]C)"
    
    Range("F27").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R5C1,R[-24]C:R[-1]C)"

        
    Range("F28").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R3C1,R[-24]C:R[-1]C)"
    
    Range("F29").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R4C1,R[-24]C:R[-1]C)"
    
    Range("F30").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R7C1,R[-24]C:R[-1]C)"
    
    Range("F31").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R6C1,R[-24]C:R[-1]C)"
    
    Range("F57").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R2C1,R[-24]C:R[-1]C)"
    
    Range("F58").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R5C1,R[-24]C:R[-1]C)"

        
    Range("F59").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R3C1,R[-24]C:R[-1]C)"

    
    Range("F60").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R4C1,R[-24]C:R[-1]C)"

    
    Range("F61").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R7C1,R[-24]C:R[-1]C)"
    
    Range("F62").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R6C1,R[-24]C:R[-1]C)"
    
    Range("F88").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R2C1,R[-24]C:R[-1]C)"
    
    Range("F89").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R5C1,R[-24]C:R[-1]C)"

        
    Range("F90").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R3C1,R[-24]C:R[-1]C)"

    
    Range("F91").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R4C1,R[-24]C:R[-1]C)"

    
    Range("F92").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R7C1,R[-24]C:R[-1]C)"
    
    Range("F93").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R6C1,R[-24]C:R[-1]C)"
    
    Range("F119").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R2C1,R[-24]C:R[-1]C)"
    
    Range("F120").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R5C1,R[-24]C:R[-1]C)"

        
    Range("F121").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R3C1,R[-24]C:R[-1]C)"

    
    Range("F122").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R4C1,R[-24]C:R[-1]C)"

    
    Range("F123").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R7C1,R[-24]C:R[-1]C)"
    
    Range("F124").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R6C1,R[-24]C:R[-1]C)"
    
    Range("F150").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R2C1,R[-24]C:R[-1]C)"
    
    Range("F151").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R5C1,R[-24]C:R[-1]C)"

        
    Range("F152").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R3C1,R[-24]C:R[-1]C)"

    
    Range("F153").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R4C1,R[-24]C:R[-1]C)"

    
    Range("F154").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R7C1,R[-24]C:R[-1]C)"
    
    Range("F155").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R6C1,R[-24]C:R[-1]C)"
    
    Range("F181").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R2C1,R[-24]C:R[-1]C)"
    
    Range("F182").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R5C1,R[-24]C:R[-1]C)"

        
    Range("F183").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R3C1,R[-24]C:R[-1]C)"

    
    Range("F184").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R4C1,R[-24]C:R[-1]C)"

    
    Range("F185").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R7C1,R[-24]C:R[-1]C)"
    
    Range("F186").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R6C1,R[-24]C:R[-1]C)"
    
    Range("F212").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R2C1,R[-24]C:R[-1]C)"
    
    Range("F213").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R5C1,R[-24]C:R[-1]C)"

        
    Range("F214").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R3C1,R[-24]C:R[-1]C)"

    
    Range("F215").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R4C1,R[-24]C:R[-1]C)"

    
    Range("F216").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R7C1,R[-24]C:R[-1]C)"
    
    Range("F217").Select
    ActiveCell.Formula2R1C1 = "=+countbycolor(R6C1,R[-24]C:R[-1]C)"


        strFormulas(1) = "+countbycolor(R2C1,R[-24]C:R[-1]C)"
        strFormulas(2) = "+countbycolor(R5C1,R[-24]C:R[-1]C)"
        strFormulas(3) = "+countbycolor(R3C1,R[-24]C:R[-1]C)"
        strFormulas(4) = "+countbycolor(R4C1,R[-24]C:R[-1]C)"
        strFormulas(5) = "+countbycolor(R7C1,R[-24]C:R[-1]C)"
        strFormulas(6) = "+countbycolor(R6C1,R[-24]C:R[-1]C)"

        
        Range("F26:AG31").FillRight
        Range("F57:AG62").FillRight
        Range("F88:AG93").FillRight
        Range("F119:AG124").FillRight
        Range("F150:AG155").FillRight
        Range("F181:AG186").FillRight
        Range("F212:AG217").FillRight

    Range("A2").Select
    ActiveCell.FormulaR1C1 = "1ST"
    Range("A3").Select

You might benefit from reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). — Pᴇʜ, Feb 19 '21 at 12:15

score 0 · Answer 1 · answered Feb 19 '21 at 14:10

One approach is below

Sub SetFormulas()
    With ActiveSheet
        For Each cl In Application.Intersect(.Columns("E"), .UsedRange)
            ' found upper row of the data in table
            If cl.Text = "Agent" Then Set Start = cl.Offset(1)
            ' found the place for formulas under table
            If UCase(cl.Text) = "1ST" Then
                If Not Start Is Nothing Then
                    ' rows between header "Agent" and "1ST" formula
                    Delta = Start.Row - cl.Row
                    ' loop for each color (category) cell
                    For i = 2 To 7
                        ' next statement construct the formula for whole row
                        cl.Offset(i - 2, 1).Resize(1, 31).FormulaR1C1 = _
                            "=countbycolor(R" & i & "C1,R[" & (Delta - i + 2) & "]C:R[" & (1 - i) & "]C)"
                    Next i
                    ' reset Start cell before next table
                    Set Start = Nothing
                End If
            End If
        Next cl
    End With
End Sub

VBA - run a formula which adapts to a range that isn't always the same

1 Answers1

One approach is below