Friday, August 24, 2018

VBA count how many times a value appears in colum if criteria is met?

I have a workbook called report and a workbook called tacker.

In my report workbook in cell B9 i have a number which is 7 in this case.

The number represents a week number.

I am copying values across from my tracker workbook to report workbook, where that row contains the number 7.

Here is my code:

Option Explicit
Sub code3()
MsgBox "This will take upto 2 minutes."

Application.ScreenUpdating = False
Dim WB As Workbook
Dim I As Long
Dim j As Long
Dim Lastrow As Long
Dim WeekNum As Integer

'Clear Data Sheet

On Error GoTo Message

With ThisWorkbook.Worksheets("Data")
    .Rows(2 & ":" & .Rows.Count).ClearContents
End With

On Error Resume Next

Set WB = Workbooks("L.O. Lines Delivery Tracker.xlsm")
On Error GoTo 0
If WB Is Nothing Then 'open workbook if not open
    Set WB = Workbooks.Open("G:\WH DISPO\(3) PROMOTIONS\(18) L.O. Delivery Tracking\L.O. Lines Delivery Tracker.xlsm")
End If

' ======= Edit #2 , also for DEBUG ======
With WB.Worksheets(1)
    Lastrow = .Cells(.Rows.Count, "G").End(xlUp).Row

    j = 2

        For I = 7 To Lastrow

        WeekNum = CInt(Format(.Range("G" & I).Value, "ww", 2) - 1)

        ' === For DEBUG ONLY ===
        Debug.Print CInt(ThisWorkbook.Worksheets(2).Range("B9").Value)
        Debug.Print WeekNum
        Debug.Print CInt(ThisWorkbook.Worksheets(2).Range("D9").Value)
        Debug.Print Year(.Range("G" & I).Value)
        Debug.Print ThisWorkbook.Worksheets(2).Range("B6").Value
        Debug.Print .Range("M" & I).Value


        If CInt(ThisWorkbook.Worksheets(3).Range("B9").Value) = WeekNum Then ' check if Month equals the value in "A1"
            If CInt(ThisWorkbook.Worksheets(3).Range("D9").Value) = Year(.Range("G" & I).Value) Then ' check if Year equals the value in "A2"
            If ThisWorkbook.Worksheets(3).Range("B6").Value = .Range("M" & I).Value Then
                ThisWorkbook.Worksheets("Data").Range("A" & j).Value = .Range("G" & I).Value
                ThisWorkbook.Worksheets("Data").Range("B" & j).Formula = "=WeekNum(A" & j & ",21)"
                ThisWorkbook.Worksheets("Data").Range("C" & j).Value = .Range("L" & I).Value
                ThisWorkbook.Worksheets("Data").Range("D" & j).Value = .Range("D" & I).Value
                ThisWorkbook.Worksheets("Data").Range("E" & j).Value = .Range("E" & I).Value
                ThisWorkbook.Worksheets("Data").Range("F" & j).Value = .Range("F" & I).Value
                ThisWorkbook.Worksheets("Data").Range("g" & j).Value = .Range("p" & I).Value
                ThisWorkbook.Worksheets("Data").Range("H" & j).Value = .Range("H" & I).Value
                ThisWorkbook.Worksheets("Data").Range("I" & j).Value = .Range("I" & I).Value
                ThisWorkbook.Worksheets("Data").Range("J" & j).Value = .Range("J" & I).Value
                ThisWorkbook.Worksheets("Data").Range("k" & j).Value = .Range("Q" & I).Value
                ThisWorkbook.Worksheets("Data").Range("L" & j).Value = .Range("m" & I).Value
                ThisWorkbook.Worksheets("Data").Range("M" & j).Value = .Range("B" & I).Value


                Dim iVal As Integer
                Dim Lastrow2 As Long
                Lastrow2 = .Cells(Rows.Count, "D").End(xlUp).Row
                iVal = Application.WorksheetFunction.CountIf(Range("D" & Lastrow2), .Range("D" & I).Value)
                ThisWorkbook.Worksheets("Data").Range("N" & j).Value = iVal

                j = j + 1
            End If
            End If
        End If
    Next I

End With




Application.Calculation = xlAutomatic
ThisWorkbook.Worksheets("Data").UsedRange.Columns("B:B").Calculate
ThisWorkbook.Worksheets(3).UsedRange.Columns("B:AA").Calculate



On Error GoTo Message
With ThisWorkbook.Worksheets(3) '<--| change "mysheet" to your actual sheet name
    Intersect(.Range(Rows(14), .UsedRange.Rows(.UsedRange.Rows.Count)), .Range("G:G")).WrapText = True
    Intersect(.Range(Rows(14), .UsedRange.Rows(.UsedRange.Rows.Count)), .Range("G:G")).EntireRow.AutoFit
End With




End

ThisWorkbook.Worksheets(3).Activate
Application.ScreenUpdating = True

ThisWorkbook.Worksheets(3).EnableFormatConditionsCalculation


Exit Sub
Message:
On Error Resume Next
Exit Sub


End Sub

Here is my problem:

During the copying process, I want to scan column D in my tracker workbook for repeat values.

I am wanting to count the number of times these repeat values occur.

I am trying to do this in this section of my code:

              Dim iVal As Integer
                Dim Lastrow2 As Long
                Lastrow2 = .Cells(Rows.Count, "D").End(xlUp).Row
                iVal = Application.WorksheetFunction.CountIf(Range("D" & Lastrow2), .Range("D" & I).Value)
                ThisWorkbook.Worksheets("Data").Range("N" & j).Value = iVal

It always produces 0 for some reason, even though there are repeat values in my column.

In addition, i also want to add a condition to this code to say count all repeat values if within 4 weeks of the week number in B9 (in my report workbook).

So for example if the report has week '7' in cell B9, then count all repeat values if for week 7, 6, 5 and 4.

Please can someone help me with my code in order to get it to do what i need?

Solved

You're only doing a count on only the last row so you need to put Range("D7:

iVal = Application.WorksheetFunction.CountIf(Range("D7:D" & Lastrow2), .Range("D" & I).Value)

Do you really need Lastrow2? can you not use I-1 instead

iVal = Application.WorksheetFunction.CountIf(Range("D7:D" & I-1), .Range("D" & I).Value)

Also, You can use conditional formatting on column D after you've copied the data to highlight all the duplicates.


since you wrote

I want to scan column D in my tracker workbook for repeat values

then you want to refer to ranges in the relevant sheet of your tracker workbook

so you have to:

  • follow your With WB.Worksheets(1) object reference by qualifying its subsequent range references by a dot (.)

  • use CountIfs() function and to add conditions

so change:

iVal = Application.WorksheetFunction.CountIf(Range("D" & Lastrow2), .Range("D" & I).Value)

to:

iVal = Application.WorksheetFunction.CountIfs(.Range("D7:D" & Lastrow2), .Range("D" & I).Value, .Range("G7:G" & Lastrow2), WeekNum ) '<--| change "G" occurrences to actual weeknumber column index in `first` sheet of "Tracker" workbook

No comments:

Post a Comment