VBA Frequency Highlighter Function in Very Large Excel Sheet

Question

In a previous post user: LocEngineer managed to help me to write a finding function that would find the least frequent values in a column of a particular category.

The VBA code works well for the most part with some particular issues, and the previous question had been answered with a sufficiently good answer already, so I thought this required a new post.

LocEngineer: "Holy smoking moly, Batman! If THAT truly is your sheet.... I'd say: forget "UsedRange". That won't work well enough with THAT spread... I've edited the above code using more hardcoded values. Please adapt the values according to your needs and try that. Woah what a mess."

Here is the code:

Sub frequenz()
Dim col As Range, cel As Range
Dim letter As String
Dim lookFor As String
Dim frequency As Long, totalRows As Long
Dim relFrequency As Double
Dim RAN As Range

RAN = ActiveSheet.Range("A6:FS126")
totalRows = 120

For Each col In RAN.Columns
    '***get column letter***
    letter = Split(ActiveSheet.Cells(1, col.Column).Address, "$")(1)
    '*******
    For Each cel In col.Cells
        lookFor = cel.Text
        frequency = Application.WorksheetFunction.CountIf(Range(letter & "2:" & letter & totalRows), lookFor)
        relFrequency = frequency / totalRows

        If relFrequency <= 0.001 Then
            cel.Interior.Color = ColorConstants.vbYellow
        End If
    Next cel

Next col

End Sub

The Code is formatted like this: (Notice the merged cells that head each column for titles. The titles go down to row 5 and data starts on row 5) (Also Notice that the rows are very much filled with empty columns, sometimes more so than data.) enter image description here

Finally, one important change I cant figure out is how to get it to ignore blank cells. Please advise. Thank you.

'set ran = range("A6:FS126")' does seem to do the trick, but still for some reason the code does not seem to highlight the lowest frequency occurances — Coding Novice, Jun 29 '15 at 20:32
It also still highlights blank space, is there any way to tell it to disregard blank cells? — Coding Novice, Jun 29 '15 at 20:34
[Blank, Empty Cell : Go here.](http://stackoverflow.com/questions/13360651/excel-how-to-check-if-a-cell-is-empty-with-vba) — bonCodigo, Jun 30 '15 at 04:21

paul bica · Accepted Answer · 2015-07-01T14:14:57.573

If the 2 adjustments to be made are to 1. exclude headers, and 2. blank cells

Exclude the headers in way a bit more dynamic; this excludes the top 6 rows:

With ActiveSheet.UsedRange
    Set ran = .Offset(6, 0).Resize(.Rows.Count - 6, .Columns.Count)
End With

In the inner For loop, after this line For Each cel In col.Cells you need an IF:

For Each cel In col.Cells
    If Len(cel.Value2) > 0 Then...

Here is the modified version (untested):

Option Explicit

Sub frequenz()
    Const MIN_ROW   As Long = 6
    Const MAX_ROW   As Long = 120

    Dim col As Range
    Dim cel As Range
    Dim rng As Range

    Dim letter      As String
    Dim lookFor     As String
    Dim frequency   As Long

    With ActiveSheet.UsedRange
        Set rng = .Offset(MIN_ROW, 0).Resize(MAX_ROW, GetMaxCell.Column)
    End With

    For Each col In rng.Columns
        letter = Split(ActiveSheet.Cells(1, col.Column).Address, "$")(1)

        For Each cel In col
            lookFor = cel.Value2

            If Len(lookFor) > 0 Then    'process non empty values
                frequency = WorksheetFunction.CountIf( _
                                Range(letter & "2:" & letter & MAX_ROW), lookFor)

                If frequency / MAX_ROW <= 0.001 Then
                    cel.Interior.Color = ColorConstants.vbYellow
                End If
            End If
        Next cel
    Next col
End Sub

.

Updated to use a new function when determining the last row and column containing values:

Public Function GetMaxCell(Optional ByRef rng As Range = Nothing) As Range

    'It returns the last cell of range with data, or A1 if Worksheet is empty

    Const NONEMPTY As String = "*"
    Dim lRow As Range, lCol As Range

    If rng Is Nothing Then Set rng = Application.ActiveWorkbook.ActiveSheet.UsedRange

    If WorksheetFunction.CountA(rng) = 0 Then
        Set GetMaxCell = rng.Parent.Cells(1, 1)
    Else
        With rng
            Set lRow = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _
                                   After:=.Cells(1, 1), _
                                   SearchDirection:=xlPrevious, _
                                   SearchOrder:=xlByRows)
            Set lCol = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _
                                   After:=.Cells(1, 1), _
                                   SearchDirection:=xlPrevious, _
                                   SearchOrder:=xlByColumns)
            Set GetMaxCell = .Parent.Cells(lRow.Row, lCol.Column)
        End With
    End If
End Function

So this looks to me fine, but when I ran it I am recieving an error here: 'lookFor = cel.Value2' of type mismatch — Coding Novice, Jul 01 '15 at 13:19
I included a new function that determines the last row and column containing data — paul bica, Jul 01 '15 at 14:16

VBA Frequency Highlighter Function in Very Large Excel Sheet

1 Answers1