CODEWITHSUNDEEP
vbaexcelconditional-formatting
Liriscia Savegna
Liriscia Savegna

Reputation: 13

Highlight values that are duplicated at least a specific number of times within a selected range

I am currently trying to solve a problem I have regarding my macro (VBA). Indeed, I wish to create a sub that ask for a specific number and then highlights the values that are duplicated at least this number of times within a variable range I want to select.

After some research, I came out with this : 

Sub HighlightOccurences()

Dim Val As String
Val = InputBox("Please enter a random number")
MsgBox "Ok, now I will show the values that are duplicated at least this number of times within the selected range"

Dim Rng As Range
Dim cel As Variant
Dim OccurenceCounter As Integer

Set Rng = Range.Select

OccurenceCounter = 0

For Each cel In Rng
    If WorksheetFunction.CountIf(Rng, cel.Value) > 0 Then
        OccurenceCounter = OccurenceCounter + 1
    End If
Next cel

For Each cel In Rng
    If OccurenceCounter = Val Then
        cel.Interior.Color = RGB(255, 255, 204)
    End If
Next cel

End Sub

However, this obviously does not work and even though I know where the issues are (the "selection process" and the highlighting part), I can't solve them with what I find online.

I hope someone will be able to help me out a bit,

Thanks a lot!

Upvotes: 0

Views: 162

Answers (2)

Scott Holtzman
Scott Holtzman

Reputation: 27249

Try this out:

Option Explicit

Sub HighlightOccurences()

    Dim randNumber As Long
    randNumber = Application.InputBox("Please enter a random number", Type:=1)

    Dim rng As Range, cel As Range
    Set rng = Application.InputBox("Choose Range to Highlight", Type:=8)

    For Each cel In rng
        If WorksheetFunction.CountIf(rng, cel.Value) >= randNumber Then
            cel.Interior.Color = RGB(255, 255, 204)
        End If
    Next cel

End Sub

Upvotes: 1

user4039065
user4039065

Reputation:

Create a conditional formatting rule.

Option Explicit

Sub HighlightOccurences()
    Dim val As Long, addr As String
    val = Application.InputBox("Please enter a random number", Type:=1)
    MsgBox "Ok, now I will show the values that are duplicated at least this number of times within the selected range"

    With Selection
        addr = .Cells(1).Address(0, 0)
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=countif(" & .Address & ", " & addr & ")>=" & val
        .FormatConditions(1).Interior.Color = 120000
    End With
End Sub

This doesn't get rid of the CFR but that is self-evident and your original code and narrative did nothing to remove the highlights either.

Upvotes: 1

Related Questions