Encountering an error/freeze using COUNTIF in VBA

Question

I'm trying to take a list of names on one sheet, check to see if it appears on a second sheet, and if it does, display on a third sheet the name and the number of times it appears.

I found some code elsewhere and attempted to adapt it for my purposes. I've used Do Until IsEmpty to run through the first worksheet and two nested IF statements to check if the name appears on the second sheet, and COUNTIF to tally them.

I thought I'd gotten everything correct, but when I try the macro it runs for a moment then hangs up and freezes. I'm very new at VBA and have probably made some very simple mistakes, but I'm not familiar enough to with VBA to find the error.

Below is the code that I'm using.

Sub NS_FPS_Macro()
Dim NSName As String
Dim FPSCount As String

Application.ScreenUpdating = False

NSName = Worksheets("Summary_Report").Range("B2").Select

Do Until IsEmpty(Worksheets("Summary_Report").Range("B:B"))
    Sheets("FPS_Report").Activate
    If ActiveCell.Value = NSName Then
        Found = True
    End If

    If Found = True Then
        FPSCount = Application.WorksheetFunction.CountIf(Range(Worksheets("FPS_Report").Range("B:B")), NSName)
        Destination = Sheets("Report").Cells(Rows.Count, "A").End(xlUp).Offset(1)
    End If
ActiveCell.Offset(1, 0).Select
Loop

Application.ScreenUpdating = True

End Sub

It's so hard to try to figure what is causing the infinite loop -that's why Excel freezes, it shouldn't be out of the loop, you may try to see what is doing by pressing F8 and see where it tends to never-ending, according to the logic it should have exited at the first empty value, but seems it is not. Also, there seems that Destination is an error, are you trying to set a range? if so you need to use Set Destination instead of Destination stand alone — Sgdva, Aug 10 '16 at 20:32
Once Found is set to True, it is never re-set back to False. This renders it meaningless. Also, why do you need to use Found anyway? It looks like you're only testing its presence in one place, so why not directly write those lines within the "If ActiveCell.Value = NSName" condition in the first place? — Chris Melville, Aug 10 '16 at 20:39
Also - all your selection and offsetting is unnecessary. Just work directly from the cells in question, without selecting them :) — Chris Melville, Aug 10 '16 at 20:42
It's an endless loop because of `Sheets("FPS_Report").Activate` which is inside the outer loop. You are never changing `Worksheets("Summary_Report").Range("B:B")`. — Brian, Aug 10 '16 at 20:50

score 1 · Accepted Answer · answered Aug 10 '16 at 21:34

The reason for the endless loop is that Worksheets("Summary_Report").Range("B:B") will never be empty.

Do Until IsEmpty(Worksheets("Summary_Report").Range("B:B"))

You could fix it like this:

Do Until IsEmpty(ActiveCell.Offset(1, 0))

But you should avoid selecting or activating whenever possible.

Sub NS_FPS_Macro()
    Dim c As Range, CountRange As Range, NamesRange As Range, DestRange As Range
    Dim FPSCount As Long

    With Worksheets("FPS_Report")
        Set CountRange = Intersect(.UsedRange, .Range("B:B"))
    End With

    With Worksheets("Summary_Report")
        Set NamesRange = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
    End With

    For Each c In NamesRange

        FPSCount = Application.WorksheetFunction.CountIf(CountRange, c.Text)
        If FPSCount > 0 Then

            Set DestRange = Sheets("Report").Cells(Rows.Count, "A").End(xlUp).Offset(1)
            DestRange.Value = c.Value
            DestRange.Offset(0, 1).Value = FPSCount

        End If
    Next

End Sub

This works perfectly! Thanks so much. I'm still learning all the intricacies of VBA and hopefully I can dig into this and learn a bit more. — Capnindigo, Aug 14 '16 at 13:27

score 0 · Answer 2 · answered Aug 10 '16 at 20:50

This might help you. It would most likely need to be modified to fit your data. It sets a name range and a lookup range, then looks through the lookup for each name. If it finds it, it keeps tally of it and eventually records it to a separate sheet.

Sub NameSearch()

Dim nameSource As range
Dim searchRange As range
Dim name As range
Dim counter As Integer
Dim openRow As Integer

'Keep track of how many times a name is found.
counter = 0

'The row where you want to store the data, mine is a blank sheet so I am starting
'at the first row.
openRow = 1

'Get the range that has the names to look for. Modify for your data.
Set nameSource = Sheets("Summary_Report").range("A1", "A4")

'Get the range to search for the name. Modify for your data.
Set searchRange = Sheets("FPS_Report").range("A1", "A15")

'Look through the search range. If a name is found, add one to the counter, and continue
For Each name In nameSource
    Set c = searchRange.Find(name.Value)
    If Not c Is Nothing Then
        firstAddress = c.address
        Do
            counter = counter + 1
            Set c = searchRange.FindNext(c)
        Loop While Not c Is Nothing And c.address <> firstAddress
    End If

    'If counter isn't 0, then name was found at least once
    If counter <> 0 Then
        Sheets("Report").range("A" & openRow).Value = name.Value
        Sheets("Report").range("B" & openRow).Value = counter

        'increment next row and reset counter
        openRow = openRow + 1
        counter = 0
    End If

Next name


End Sub

Encountering an error/freeze using COUNTIF in VBA

2 Answers2