CoutIf formula in VBA, loop and select columns

[espenskeie]

Hi

I tried to modify my code such that it can work on a countif formula:

Const strFormula    As String = "=COUNTIF( @@ , >0)"

This codeline is bugging:

rngFormula.Formula = Replace(strFormula, "@@", strColumns)

Here is the code:

Sub risk_factor()


Dim lr As Long, i As Long, lrX As Long
Dim wb As Workbook
Dim ws1 As Worksheet, wsX As Worksheet, ws3 As Worksheet
Dim strColumns As String, sName As String, strAddress As String
Dim rngChk          As Range
Dim rng             As Range    'Loop Counter
Dim rngFormula      As Range
Dim rngFill         As Range
 
Const strFormula    As String = "=COUNTIF( @@ , >0)"
    
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Master")
    Set ws1 = wb.Sheets("Graphics")
    Set ws3 = wb.Sheets("All")
        
    For Each wsX In ThisWorkbook.Worksheets
        If IsError(Application.Match(wsX.Name, Array("Graphics", "Master", "All", "Bonds"), 0)) Then
        
        strColumns = ""
        j = j + 1
        
        lr = ws.Cells(8, j + 2).End(xlDown).Row
                
                sName = ws1.Cells(j + 6, 15).Value
                Set wsX = wb.Worksheets(sName)
                
                    wsX.Activate
                    
                If wsX.Cells(1, 4).Value <> 0 Then ' If risk column is missing, then add it, if not go next
                    wsX.Cells(1, 4).Activate
                    ActiveCell.EntireColumn.Insert
                End If
                
                For i = 7 To lr 'This loop goes through all strategies listed in Graphic Sheet
                    lrX = wsX.Range("O6").End(xlDown).Row
 
                    stock = ws.Cells(i, j + 2)
                    Set rng = wsX.Rows(4).Find(stock)
 
                        With wsX
                            .Activate
                            Set rngFormula = .Range("D5")
                            Set rngFill = .Range(Cells(5, 4), Cells(lr, 4))
                        End With
                        
                        If rng Is Nothing Then
                         ' No columns for this month in Master
                        Else
                            strColumns = strColumns & Replace(rng.Address, "$", "") & ", "  'Actual column
                            'rx = wsX.Cells(
                        End If
                Next i
                 
                    strColumns = Left(strColumns, Len(strColumns) - 2)
                    rngFormula.Formula = Replace(strFormula, "@@", strColumns)
                    rngFormula.AutoFill rngFill
            End If
        Next wsX
    
    
End Sub

Kind regards
Espen

 

[espenskeie]

I found a workaround, since my range is non contiguous it didn't work with ordinary "countif"

But here's the solution:

Averaging a Non-Contiguous Range (Microsoft Excel)