Check a shifting range with numbers for duplicates and highlight?

NessPJ

Active Member
Joined
May 10, 2011
Messages
431
Office Version
  1. 365
Hi,

I am looking for a way to check for duplicates in a moving range and highlight them.

For example i have Columns K, L, M, N roughly 2000 lines filled with numbers and i want every Cell to check the surrounding 36 Cells for a duplicate and when there is, highlight it.

Is this possible?
 

Attachments

  • mrexcel_chkdup.jpg
    mrexcel_chkdup.jpg
    117 KB · Views: 18

This seems to work exactly. Can't believe the formula was that simple. Thanks a lot!
 
Upvote 0

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
PS.
Now i created the following VBA code to accompany the conditional formatting as discussed here. But i keep getting an error when trying to write the Formula to the designated Cell.

Line:
TableCell.Formula = "=Text(RandBetweenInt(" & Lowest & "; " & Highest & "; " & Exclude & "); " & TextFormat & ")"
Keeps giving me an error (Object variable not set).
I expect the VBA to read the value from Cell Sheets("PARAMETERS").Range("M48").Value which actually contains a Range for the formula (value; PARAMETERS!$B$7:$B$10).
What am i doing wrong here? :)

VBA Code:
Sub FindAndSolveDupes()

Dim CurSheet As String
Dim CurWb As Workbook
Dim DupeColor As String
Dim TableRange As Range, TableCell As Range
Dim Lowest As Long, Highest As Long, Exclude As Range, TextFormat As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

START:

DupeColor = Sheets("PARAMETERS").Range("M45").DisplayFormat.Interior.ColorIndex
'Default Orange color from Excel Colorindex = 44

Lowest = Sheets("PARAMETERS").Range("M46").Value
Highest = Sheets("PARAMETERS").Range("M47").Value
Exclude = Sheets("PARAMETERS").Range("M48").Value
TextFormat = Sheets("PARAMETERS").Range("M49").Value

Set TableRange = Selection
    For Each TableCell In TableRange
        If TableCell.DisplayFormat.Interior.ColorIndex = DupeColor Then
        TableCell.NumberFormat = "General"
        TableCell.Formula = "=Text(RandBetweenInt(" & Lowest & "; " & Highest & "; " & Exclude & "); " & TextFormat & ")"
        Application.Calculate
        TableCell.Formula = TableCell.Value
        End If

    Next TableCell
   
EINDE:

Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub

Function RandBetweenInt(Lowest As Long, Highest As Long, Exclude As Range) As Long

Dim R As Long
Dim C As Range
Do
R = Lowest + Int(Rnd() * (Highest + 1 - Lowest))
For Each C In Exclude
If R = C Then Exit For
Next C
Loop Until C Is Nothing

RandBetweenInt = R
Application.Volatile

End Function
 
Upvote 0
When entering a formula with vba, use commas not semicolons, even if your Excel version normally uses semicolons for a worksheet formula separator.

If that does not resolve your problem please tell us what, exactly, is in each of these cells?

1733883288347.png
 
Upvote 0
When entering a formula with vba, use commas not semicolons, even if your Excel version normally uses semicolons for a worksheet formula separator.

If that does not resolve your problem please tell us what, exactly, is in each of these cells?

View attachment 120261

Okay, so i tried updating the code with a Set as Range, but sadly that still did not work.
The values that are in those variables (and the Cells) are:

Lowest = 1
Highest = 99

ExcludeSheet = PARAMETERS
ExcludeAddress = $B$7:$B$10
Set Exclude = Sheets(ExcludeSheet).Range(ExcludeAddress)

TextFormat = 00

I still seem to be getting a "Type Mismatch" on "Exclude".

VBA Code:
Sub FindAndSolveDupes()

Dim CurSheet As String
Dim CurWb As Workbook
Dim DupeColor As String
Dim TableRange As Range, TableCell As Range
Dim Lowest As Long, Highest As Long, ExcludeSheet As String, ExcludeAddress As String, Exclude As Range, TextFormat As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

START:

DupeColor = Sheets("PARAMETERS").Range("M45").DisplayFormat.Interior.ColorIndex
'Default Orange color from Excel Colorindex = 44

Lowest = Sheets("PARAMETERS").Range("M46").Value
Highest = Sheets("PARAMETERS").Range("M47").Value

ExcludeSheet = Sheets("PARAMETERS").Range("M48").Value
ExcludeAddress = Sheets("PARAMETERS").Range("M49").Value
Set Exclude = Sheets(ExcludeSheet).Range(ExcludeAddress)

TextFormat = Sheets("PARAMETERS").Range("M50").Value

Set TableRange = Selection
    For Each TableCell In TableRange
        If TableCell.DisplayFormat.Interior.ColorIndex = DupeColor Then
        TableCell.NumberFormat = "General"
        TableCell.Formula = "=Text(RandBetweenInt(" & Lowest & ", " & Highest & ", " & Exclude & "), " & TextFormat & ")"
        Application.Calculate
        TableCell.Formula = TableCell.Value
        End If

    Next TableCell
    
EINDE:

Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub

Function RandBetweenInt(Lowest As Long, Highest As Long, Exclude As Range) As Long

Dim R As Long
Dim C As Range
Do
R = Lowest + Int(Rnd() * (Highest + 1 - Lowest))
For Each C In Exclude
If R = C Then Exit For
Next C
Loop Until C Is Nothing

RandBetweenInt = R
Application.Volatile

End Function
 
Upvote 0
This seems to have done the trick
VBA Code:
Dim Lowest As Long, Highest As Long, ExcludeSheet As String, ExcludeAddress As String, Exclude As Range, TextFormat As String

ExcludeSheet = Sheets("PARAMETERS").Range("M48").Value
ExcludeAddress = Sheets("PARAMETERS").Range("M49").Value
Set Exclude = Sheets(ExcludeSheet).Range(ExcludeAddress)
ExcludeString = "'" & ExcludeSheet & "'!" & Exclude.Address


TableCell.Formula = "=Text(RandBetweenInt(" & Lowest & ", " & Highest & ", " & ExcludeString & "), " & TextFormat & ")"
 
Upvote 0
Glad you seem to have resolved it. Thanks for letting us know. (y)
 
Upvote 0

Forum statistics

Threads
1,226,462
Messages
6,191,174
Members
453,644
Latest member
karlpravin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top