Expanding exisitng VBA code with CountIf conditions

Question

I'm trying to figure out how to expand the code below with the following countif conditions:

If a row in Workbbook 1(wbSource) has the values in Column H = "01.January" and Column AD = < 50 then count and enter the result in cell B8 in Sheet 2 of Workbook 2(ThisWorkbook) after the whole wbSource is checked.
If a row in wbSource has the values Column H = "01.January" and Column AD = > 50 and < 100 then count and enter the result in cell B9 in Sheet 2 of ThisWorkbook after the whole wbSource is checked.
If a row in wbSource has the values Column H = "01.January" and Column AD = > 100 then count and enter the result in cell B10 in Sheet 2 of ThisWorkbook after the whole wbSource is checked.

This should be repeated for every month.

The entire concept is based around an user form with a file explorer function, where the user can select an excel file and evaluate it automatically based on the avarage_calc and countif conditions by clicking on a command button. Thats why I would need it as VBA.

Any idea how to add the countif function based on the conditions above, as addition to my existing code?

Private Sub CommandButton2_Click() ' update averages
     Const YEAR = 2019

    ' open source workbook
    Dim fname As String, wbSource As Workbook, wsSource As Worksheet
    fname = Me.TextBox1.Text

    If Len(fname) = 0 Then
       MsgBox "No file selected", vbCritical, "Error"
       Exit Sub
    End If

    Set wbSource = Workbooks.Open(fname, False, True) ' no link update, read only
    Set wsSource = wbSource.Sheets("Sheet1") ' change to suit

    Dim wb As Workbook, ws As Worksheet
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Table 2") '

    ' scan down source workbook calc average
    Dim iRow As Long, lastRow As Long
    Dim sMth As String, iMth As Long
    Dim count(12) As Long, sum(12) As Long

    lastRow = wsSource.Cells(Rows.count, 1).End(xlUp).Row
    For iRow = 1 To lastRow

        If IsDate(wsSource.Cells(iRow, 8)) _
            And IsNumeric(wsSource.Cells(iRow, 30)) Then

            iMth = Month(wsSource.Cells(iRow, 8))   ' col H
            sum(iMth) = sum(iMth) + wsSource.Cells(iRow, 30) ' Col AD
            count(iMth) = count(iMth) + 1 '

        End If
    Next

    ' close source worbook no save
    wbSource.Close False

    ' update Table 2 with averages
    With ws.Range("A3")
    For iMth = 1 To 12
        .Offset(0, iMth - 1) = MonthName(iMth) & " " & YEAR
        If count(iMth) > 0 Then
            .Offset(1, iMth - 1) = sum(iMth) / count(iMth)
            .Offset(1, iMth - 1).NumberFormat = "0.0"
        End If
    Next
    End With


    Dim msg As String
    msg = iRow - 1 & " rows scanned in " & TextBox1.Text
    MsgBox msg, vbInformation, "Table 2 updated"

End Sub

Wb result sheet2

wb.Source sheet1

I wonder, if (this and that), then what range is to count ? Or do you mean (1) count column AD if column H is certain value.... then (2) if the count result (of column AD) is =< 50 then put it in Sheet2 cell B8 ? — karma
Thanks for the feedback, I want the code to count row x if cells of row x in column AD & H are fulfilling the conditions. This is basically all I need. — PlutoX

barvobot barvobot · Accepted Answer · 2020-05-08T15:22:25

I think I see what you are looking for, forgive me if I've missed the point completely. You should be able to throw this at the bottom of your existing code. A few notes:

Since I'm assuming you don't want each month's values to overwrite the previous month's, I made January go in column B, February in C, etc. (it's the 1+x portion if you want to change it).
EDIT: The loop 1 to 12 paired with the m = function will loop through the date ranges you're looking for.

I also changed the formulas for the second and third functions so that you don't have overlap (as 1 had <= 50 and 2 had >= 50, so anything equaling 50 would have shown up in both).

Dim x as Long
Dim m as Date

For x = 1 To 12

    m = CDate(x & "/1/2019")

    ws.Cells(8, 1 + x) = _
        Application.WorksheetFunction.CountIfs(wsSource.Columns(8), m, _
        wsSource.Columns(30), "<=" & 50)

    ws.Cells(9, 1 + x) = _
        Application.WorksheetFunction.CountIfs(wsSource.Columns(8), m, _
        wsSource.Columns(30), ">" & 50, wsSource.Columns(30), "<=" & 100)

    ws.Cells(10, 1 + x) = _
        Application.WorksheetFunction.CountIfs(wsSource.Columns(8), m, _
        wsSource.Columns(30), ">" & 100)

Next x

Expanding exisitng VBA code with CountIf conditions

1 Answers