Need conditional formating when doubles

ADRIANA P
ADRIANA P used Ask the Experts™
on
have an list of numbers
but i need identifu the doublesas i type in

like the example  here
3num-doubles-examples.xlsx
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
ADRIANA PACCOUNTING ASSISTANT

Author

Commented:
sorry my keyboard give me some hard times
some times

I have an list of numbers
but i need identify  the doubles as i type in
ShumsManaging Director/Excel VBA Developer
Distinguished Expert 2018

Commented:
Hi Adriana,

Please find attached. Its automated with VBA.
3num-doubles-examples_v1.xlsm
ShumsManaging Director/Excel VBA Developer
Distinguished Expert 2018

Commented:
The code used is:
Sub HighlightDups()

    Dim wstMySheet As Worksheet
    Dim clnUniqueValues As New Collection
    Dim rngCell As Range
    Dim lngEndRow As Long
    
    Set wstMySheet = Sheets("Sheet1") 'Sheet containing data. Change to suit.
    
    lngEndRow = wstMySheet.Range("B:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    Application.ScreenUpdating = False
    
    For Each rngCell In wstMySheet.Range("B5:B" & lngEndRow) 'Assumes the data is in Col B (starting at Row 5) of 'wstMySheet'. Change to suit.
        On Error Resume Next 'OK to ignore 'This key is already associated with an element of this collection' error message.
            clnUniqueValues.Add rngCell, CStr(rngCell)
            If Err.Number <> 0 Then
                wstMySheet.Range("B" & rngCell.Row).Interior.Color = RGB(255, 255, 0) 'Yellow. Change to suit.
                wstMySheet.Range("B" & rngCell.Row).Font.Color = RGB(156, 0, 6) 'Dark Red
                wstMySheet.Range("B" & rngCell.Row).Font.Bold = True
            End If
            Err.Clear
        On Error GoTo 0
    Next rngCell
    
    Application.ScreenUpdating = True
    
    'Remove objects from memory
    Set wstMySheet = Nothing
    Set clnUniqueValues = Nothing

End Sub

Open in new window

Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

ADRIANA PACCOUNTING ASSISTANT

Author

Commented:
Shums !! fast response always like that from you my  good friend !!

but still dont; work for me because

I need as i type in
and have to be all the list numbers in the list already in
ShumsManaging Director/Excel VBA Developer
Distinguished Expert 2018

Commented:
After typing just press that button Highlight Duplicates. It will highlight.
I have changed the code, it will reset the old duplicates and highlight only latest duplicates.
Sub HighlightDups()

    Dim wstMySheet As Worksheet
    Dim clnUniqueValues As New Collection
    Dim rngCell As Range
    Dim lngEndRow As Long
    
    Set wstMySheet = Sheets("Sheet1") 'Sheet containing data. Change to suit.
    
    lngEndRow = wstMySheet.Range("B:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    Application.ScreenUpdating = False
    
    
    For Each rngCell In wstMySheet.Range("B5:B" & lngEndRow) 'Assumes the data is in Col B (starting at Row 5) of 'wstMySheet'. Change to suit.
        On Error Resume Next 'OK to ignore 'This key is already associated with an element of this collection' error message.
            clnUniqueValues.Add rngCell, CStr(rngCell)
            wstMySheet.Range("B" & rngCell.Row).Interior.Pattern = xlNone
            wstMySheet.Range("B" & rngCell.Row).Font.ColorIndex = xlAutomatic
            wstMySheet.Range("B" & rngCell.Row).Font.Bold = False
            If Err.Number <> 0 Then
                wstMySheet.Range("B" & rngCell.Row).Interior.Color = RGB(255, 255, 0) 'Yellow. Change to suit.
                wstMySheet.Range("B" & rngCell.Row).Font.Color = RGB(156, 0, 6) 'Dark Red
                wstMySheet.Range("B" & rngCell.Row).Font.Bold = True
            End If
            Err.Clear
        On Error GoTo 0
    Next rngCell
    
    Application.ScreenUpdating = True
    
    'Remove objects from memory
    Set wstMySheet = Nothing
    Set clnUniqueValues = Nothing

End Sub

Open in new window

3num-doubles-examples_v2.xlsm
ADRIANA PACCOUNTING ASSISTANT

Author

Commented:
Shums have to be all the numbers
not
just one or the last one
ShumsManaging Director/Excel VBA Developer
Distinguished Expert 2018

Commented:
If you want to highlight duplicates manually then follow below steps:
1. Select the range you want to highlight
2. Navigate to Home/Conditional Formatting/Highlight Cells Rule/Duplicate Values
3. Default color would be Light Red Fill with Dark Red Text, If you want custom color, click the drop-down key (right after Color selection)
4. Custom Format/Font/Color (Automatic) change the color you want, Fill the color you want
5. Press OK
6. Press OK.
And you are done
ShumsManaging Director/Excel VBA Developer
Distinguished Expert 2018

Commented:
Please find attached...try to type any duplicate numbers, it will be highlighted
3num-doubles-examples_v3.xlsx
ADRIANA PACCOUNTING ASSISTANT

Author

Commented:
ok im interest in doubles numbers
not duplicates numbers
 numbers like
552
616
828
225
but the doubles numbers can be in any position
could be

552
225
252
522
ShumsManaging Director/Excel VBA Developer
Distinguished Expert 2018

Commented:
Oopps....Sorry for misunderstanding.
Managing Director/Excel VBA Developer
Distinguished Expert 2018
Commented:
Hi Adriana,

Please find attached. Hope this helps...
3num-doubles-examples_v4.xlsx
ADRIANA PACCOUNTING ASSISTANT

Author

Commented:
Yes ! that's im talking about i!!
great job !
ADRIANA PACCOUNTING ASSISTANT

Author

Commented:
Great Job !
ShumsManaging Director/Excel VBA Developer
Distinguished Expert 2018

Commented:
You're Welcome Adriana! Glad I was able to help

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial