Flyte One
Flyte One

Reputation: 11

EXCEL: highlighting reoccuring data in the same column

I have a column(D) of data in Excel that has been sorted using: =TEXT(B2,"###"). This is to show a list of data (numberical) that has an additional "REP 1" against it.

Not all data has a "REP 1" in there, so I would like to highlight all fields which contain BOTH the number and the "REP 1". I could highlight all "REP 1" fields, and see if there is a duplicate before it, but this is just a sample sheet. I have over 8,000+ fields to go through, and would be too time consuming.

Please see the below link for the example:

Required Formatting

I hope this all makes sense. Thanks,

Tim.

Upvotes: 1

Views: 53

Answers (1)

AmyOakes
AmyOakes

Reputation: 61

Not sure if its possible to do with conditional formatting but this VBA code should work. Your Data wouldn't have to be sorted in any particular order, and assumes the data you are formatting is in column D. I've tested on a few 100 rows and it works fine, so should be fine with a large data set. Ive tried to explain what the code is doing through the comments in the code.

            Sub formatCells()


            Dim x As Variant
            Dim y As Variant
            Dim searchval As String
            Dim a As Variant
            Dim lastrow As Long
            Dim rng As Range

            Application.ScreenUpdating = False ' turn off screen updates

            lastrow = Cells(Rows.Count, 4).End(xlUp).Row 'find the last blank cell
            x = 2 'set rownumber
            y = 4 'set columnnumber


            While Cells(x, y) <> "" ' create loop
                If InStr(Cells(x, y), "REP1") Then 'search for string in cell
                    Cells(x, y).Interior.Color = RGB(255, 0, 0) 'if string exists fill cell

                End If

            x = x + 1 ' loop

            Wend ' end loop

            x = 2 ' reset row number
            y = 4 ' reset column number

            While Cells(x, y) <> "" ' create loop 2
                If Cells(x, y).Interior.Color = RGB(255, 0, 0) And InStr(Cells(x, y), "REP1") Then 'if cells is red and contains Rep1

                    a = Cells(x, y).Value ' set a to equal the cell that is red and and contains REP1
                        searchval = Left(a, Len(a) - 5) 'remove space and REP1 and set value ready for search

                    If searchval <> "" Then 'if theres a search value available run steps below

                        With Range("D1:D" & lastrow) 'set range to be column A
                            Set rng = .Find(What:=searchval, _
                                        After:=.Cells(1), _
                                        LookIn:=xlValues, _
                                        LookAt:=xlWhole, _
                                        SearchOrder:=xlByRows, _
                                        SearchDirection:=xlPrevious, _
                                        MatchCase:=False)
                            If Not rng Is Nothing Then 'If search value is found
                                Application.Goto rng, True ' go to cell
                                ActiveCell.Interior.Color = RGB(255, 0, 0) 'set cell to red
                             End If
                        End With

                    End If
                End If

             x = x + 1 'loop 2

            Wend ' end loop 2

            End Sub

EDIT - Looks at column B not D

            Sub formatCells()


        Dim x As Variant
        Dim y As Variant
        Dim searchval As String
        Dim a As Variant
        Dim lastrow As Long
        Dim rng As Range

        Application.ScreenUpdating = False ' turn off screen updates

        lastrow = Cells(Rows.Count, 2).End(xlUp).Row 'find the last blank cell
        x = 2 'set rownumber
        y = 2 'set columnnumber


        While Cells(x, y) <> "" ' create loop
            If InStr(Cells(x, y), "REP1") Then 'search for string in cell
                Cells(x, y).Interior.Color = RGB(255, 0, 0) 'if string exists fill cell

            End If

        x = x + 1 ' loop

        Wend ' end loop

        x = 2 ' reset row number
        y = 2 ' reset column number

        While Cells(x, y) <> "" ' create loop 2
            If Cells(x, y).Interior.Color = RGB(255, 0, 0) And InStr(Cells(x, y), "REP1") Then 'if cells is red and contains Rep1

                a = Cells(x, y).Value ' set a to equal the cell that is red and and contains REP1
                    searchval = Left(a, Len(a) - 5) 'remove space and REP1 and set value ready for search

                If searchval <> "" Then 'if theres a search value available run steps below

                    With Range("B1:B" & lastrow) 'set range to be column A
                        Set rng = .Find(What:=searchval, _
                                    After:=.Cells(1), _
                                    LookIn:=xlValues, _
                                    LookAt:=xlWhole, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlPrevious, _
                                    MatchCase:=False)
                        If Not rng Is Nothing Then 'If search value is found
                            Application.Goto rng, True ' go to cell
                            ActiveCell.Interior.Color = RGB(255, 0, 0) 'set cell to red
                         End If
                    End With

                End If
            End If

         x = x + 1 'loop 2

        Wend ' end loop 2

        End Sub

Upvotes: 1

Related Questions