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
0
ShumsDistinguished Expert - 2017Commented:
Hi Adriana,

Please find attached. Its automated with VBA.
3num-doubles-examples_v1.xlsm
0
ShumsDistinguished Expert - 2017Commented:
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

0
Determine the Perfect Price for Your IT Services

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

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

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

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 !
0
ADRIANA PACCOUNTING ASSISTANTAuthor Commented:
Great Job !
0
ShumsDistinguished Expert - 2017Commented:
You're Welcome Adriana! Glad I was able to help
0
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.