Need conditional formating when doubles

have an list of numbers
but i need identifu the doublesas i type in

like the example  here
3num-doubles-examples.xlsx
ADRIANA PACCOUNTING ASSISTANTAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

ADRIANA PACCOUNTING ASSISTANTAuthor 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
ShumsExcel & VBA ExpertCommented:
Hi Adriana,

Please find attached. Its automated with VBA.
3num-doubles-examples_v1.xlsm
ShumsExcel & VBA ExpertCommented:
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

Price Your IT Services for Profit

Managed service contracts are great - when they're making you money. Yes, you’re getting paid monthly, but is it actually profitable? Learn to calculate your hourly overhead burden so you can master your IT services pricing strategy.

ADRIANA PACCOUNTING ASSISTANTAuthor 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
ShumsExcel & VBA ExpertCommented:
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 ASSISTANTAuthor Commented:
Shums have to be all the numbers
not
just one or the last one
ShumsExcel & VBA ExpertCommented:
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
ShumsExcel & VBA ExpertCommented:
Please find attached...try to type any duplicate numbers, it will be highlighted
3num-doubles-examples_v3.xlsx
ADRIANA PACCOUNTING ASSISTANTAuthor 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
ShumsExcel & VBA ExpertCommented:
Oopps....Sorry for misunderstanding.
ShumsExcel & VBA ExpertCommented:
Hi Adriana,

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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
Yes ! that's im talking about i!!
great job !
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
Great Job !
ShumsExcel & VBA ExpertCommented:
You're Welcome Adriana! Glad I was able to help
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.