so i have a workbook set up with Sheet 1 named Legacy Parts. This sheet contains all the old part numbers in column A and all the new part numbers in Column B. I have different color fills in each one depending on Drawing revision state they are in. I want to set up more tabs for each Sub-Assembly to sort the new part numbers for easier viewing and I need the color fills to follow from the sheet 1. Example I have a tab labeled BR so all the CVI-SS960-BR-XXXX-A parts will go there and so forth. Issue is the old legacy part numbers are in sequential order which puts the new numbers scattered. So in my new BR tab I have each cell calling to a specific cell in the first sheet, Example on the BR sheet which is sheet 3 btw A2 is filled in with ='Legacy Parts'!A33 and C2 is ='Legacy Parts'!C33. I started a code I found on here but it's not auto updating the colors in all cell fields for me. Here is my code I am using posted in Sheet1 (Code), any help cleaning it up or showing me where I am going wrong will help a lot.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'updated by Extendoffice 20201127
Dim xRg As Range
Dim xCRg As Range
Dim xStrAddress As String
Dim xFNum As Integer
xStrAddress = "'BR'!$A$2:$C$2"
xStrAddress = "'BR'!$A$3:$C$4"
xStrAddress = "'BR'!$A$5:$C$5"
xStrAddress = "'BR'!$A$6:$C$11"
xStrAddress = "'BR'!$A$12:$C$12"
Set xRg = Application.Range(xStrAddress)
Set xCRg = Me.Range("'Legacy Parts'!$A$33:$C$33")
Set xCRg = Me.Range("'Legacy Parts'!$A$35:$C$36")
Set xCRg = Me.Range("'Legacy Parts'!$A$37:$C$37")
Set xCRg = Me.Range("'Legacy Parts'!$A$40:$C$45")
Set xCRg = Me.Range("'Legacy Parts'!$A$55:$C$55")
On Error Resume Next
For xFNum = 1 To xRg.Count
xRg.Item(xFNum).Interior.Color = xCRg.Item(xFNum).Interior.Color
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'updated by Extendoffice 20201127
Dim xRg As Range
Dim xCRg As Range
Dim xStrAddress As String
Dim xFNum As Integer
xStrAddress = "'BR'!$A$2:$C$2"
xStrAddress = "'BR'!$A$3:$C$4"
xStrAddress = "'BR'!$A$5:$C$5"
xStrAddress = "'BR'!$A$6:$C$11"
xStrAddress = "'BR'!$A$12:$C$12"
Set xRg = Application.Range(xStrAddress)
Set xCRg = Me.Range("'Legacy Parts'!$A$33:$C$33")
Set xCRg = Me.Range("'Legacy Parts'!$A$35:$C$36")
Set xCRg = Me.Range("'Legacy Parts'!$A$37:$C$37")
Set xCRg = Me.Range("'Legacy Parts'!$A$40:$C$45")
Set xCRg = Me.Range("'Legacy Parts'!$A$55:$C$55")
On Error Resume Next
For xFNum = 1 To xRg.Count
xRg.Item(xFNum).Interior.Color = xCRg.Item(xFNum).Interior.Color
Next
End Sub