Code To Look At Column C And If All Data Matches In Column AC Copy To Sheet 2

Dazzawm

Well-known Member
Joined
Jan 24, 2011
Messages
3,748
Office Version
  1. 365
Platform
  1. Windows
I have a file as laid out below. I need the code to look at column C and if the data matches then look at column AC. If all the data in column AC says 'NYA' then copy to sheet 2 like the second example. Thanks.

Excel 2010
CAC
1CatCodeStockCode
2AAROC18 3001NYA
3AAROC18 3001NYA
4AAROC22D 3001NYA
5AAROC22D 3001NYA
6AM40004D 1001NYA
7AM40004D 1001NYA
8AM40004D 1001NYA
9AM50005 1001NYA
10AM50005 7001TEST
11AM50005 7001NYA
12AM50005D 1001NYA
13AM50005D 1001NYA
14AM50005D 5001TEST
15AM50005D 5001NYA
16AM50005D 5001NYA
17AM50005D 7001NYA
18AMCIT04D 1001TEST
19AMCIT04D 1001NYA

<colgroup><col style="width: 25pxpx"><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Sheet1



As you can see below I have highlighted in yellow what needs to be copied as the data in C matches and in column AC they say NYA.


Excel 2010
CAC
1CatCodeStockCode
2AAROC18 3001NYA
3AAROC18 3001NYA
4AAROC22D 3001NYA
5AAROC22D 3001NYA
6AM40004D 1001NYA
7AM40004D 1001NYA
8AM40004D 1001NYA
9AM50005 1001NYA
10AM50005 7001TEST
11AM50005 7001NYA
12AM50005D 1001NYA
13AM50005D 1001NYA
14AM50005D 5001TEST
15AM50005D 5001NYA
16AM50005D 5001NYA
17AM50005D 7001NYA
18AMCIT04D 1001TEST
19AMCIT04D 1001NYA
Sheet2
 
Last edited:

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
The rows don't necessarily have to be copied to sheet 2, just highlighted like I have above.
 
Upvote 0
Can someone please help I need it for work!
 
Upvote 0
Hello Dazzawm,

Do you want the entire row highlighted or just these two cells?
 
Upvote 0
AM50005 1001 was highlighted and is a unique value. Is this correct?
 
Upvote 0
Hello Dazzawm,

This worked on the data you provided.
Code:
Sub TestMacro1()

    Dim Cell    As Range
    Dim col     As Long
    Dim Dict    As Object
    Dim Key     As String
    Dim Item    As Variant
    Dim Rng     As Range
    Dim Wks     As Worksheet
    
        Set Wks = Worksheets("Sheet1")
        
        Set Rng = Wks.Range("C2")
        
      ' Offset from Rng column to validation column.
        col = 26
        
        EndRow = Wks.Cells(Rows.Count, Rng.Column).End(xlUp).Row
        If EndRow > Rng.Row Then Set Rng = Rng.Resize(EndRow - Rng.Row + 1, 1)
        
        Set Dict = CreateObject("Scripting.Dictionary")
        Dict.CompareMode = vbTextComapre
        
        Application.ScreenUpdating = False
        
            For Each Cell In Rng
                Key = Trim(Cell)
                If Key <> "" And Cell.Offset(0, col) = "NYA" Then
                    If Not Dict.exists(Key) Then
                        Set Item = Cell
                        Dict.Add Key, Item
                    Else
                        Set Item = Dict(Key)
                            Item.Interior.Color = vbYellow
                            Item.Offset(0, col).Interior.Color = vbYellow
                            Cell.Interior.Color = vbYellow
                            Cell.Offset(0, col).Interior.Color = vbYellow
                        Set Dict(Key) = Cell
                    End If
                End If
            Next Cell
            
        Application.ScreenUpdating = True
        
End Sub
 
Upvote 0
Hello Dazzawm,,

This macro highlights the entire row.
Code:
Sub TestMacro2()

    Dim Cell    As Range
    Dim col     As Long
    Dim Dict    As Object
    Dim Key     As String
    Dim Item    As Variant
    Dim Rng     As Range
    Dim Wks     As Worksheet
    
        Set Wks = Worksheets("Sheet2")
        
        Set Rng = Wks.Range("A2")
        
      ' Offset from Rng column to validation column.
        col = 26
        
        EndRow = Wks.Cells(Rows.Count, Rng.Column).End(xlUp).Row
        If EndRow > Rng.Row Then Set Rng = Rng.Resize(EndRow - Rng.Row + 1, 1)
        
        Set Dict = CreateObject("Scripting.Dictionary")
        Dict.CompareMode = vbTextComapre
        
        Application.ScreenUpdating = False
        
            For Each Cell In Rng
                Key = Trim(Cell)
                If Key <> "" And Cell.Offset(0, col) = "NYA" Then
                    If Not Dict.exists(Key) Then
                        Set Item = Cell
                        Dict.Add Key, Item
                    Else
                        Set Item = Dict(Key)
                            Item.EntireRow.Interior.Color = vbYellow
                            Cell.EntireRow.Interior.Color = vbYellow
                        Set Dict(Key) = Cell
                    End If
                End If
            Next Cell
            
        Application.ScreenUpdating = True
        
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,486
Messages
6,113,932
Members
448,533
Latest member
thietbibeboiwasaco

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