Link values between 2 cells, same row different columns

[kromer12]

Hello All,

I have a sheet that has a list of sheet names that "live" updates, when a new sheet is added or a sheet is moved in the workbook the list updates accordingly to keep the order the sheets are in. However, the column next to that list of names allows the user to place an "x" in cell to exclude that row from being calculated into an average at the top. When the list of sheet names updates and sheet "6-5-15" moves down one row the "x" that was placed in the column next to it needs to move with it so that row is still excluded from the averages.

Below is an example of the list of sheet names and the "x" column and the current code I am attempting to use.

When sheet "6-27-15" is created it is added to row 13 automatically using an array formula, but the x needs to move from row 13 to row 14 to align with sheet name "6-26-15"

[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]B[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]U[/TD]
[TD]V[/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD]Exclude(x)[/TD]
[TD](Sheet Names)[/TD]
[TD]Boxes[/TD]
[TD]Old (x)[/TD]
[TD]Old List[/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD]x[/TD]
[TD]6-27-15[/TD]
[TD]100[/TD]
[TD]x[/TD]
[TD]6-26-15[/TD]
[/TR]
[TR]
[TD]14[/TD]
[TD][/TD]
[TD]6-26-15[/TD]
[TD]120[/TD]
[TD][/TD]
[TD]6-25-15[/TD]
[/TR]
[TR]
[TD]15[/TD]
[TD][/TD]
[TD]6-25-15[/TD]
[TD]90[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

    Dim m_lngNSheets As Long

    Private Sub Workbook_Open()    m_lngNSheets = ThisWorkbook.Sheets.Count
    
    Worksheets("Main").Range("B13:B600").Copy
    Worksheets("Main").Range("U13").PasteSpecial Paste:=xlPasteValues
    Worksheets("Main").Range("F13:F600").Copy
    Worksheets("Main").Range("V13").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    ActiveSheet.Range("A1").Select


End Sub


Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim main As Worksheet, i As Integer, urow As String, uday As String
    
    If ThisWorkbook.Sheets.Count > m_lngNSheets Then
        MsgBox "New Sheet Copied or Added " & Sh.Name
    End If
    m_lngNSheets = ThisWorkbook.Sheets.Count
    
    Set main = Sheets("Main")
    i = 13
    Do Until main.Cells(i, 6).Value = ""
        uday = main.Cells(i, 22).Value
        If main.Cells(i, 6).Value = uday Then
        Else
            urow = Application.WorksheetFunction.Match(uday, Range("F1:F600"), 0)
            main.Cells(urow, 2).Value = main.Cells(i, 21).Value
        End If
        i = i + 1
    Loop
     
    End Sub

 

[kromer12]

Problem solved! Instead of allowing a user to manually copy/move tabs I added a macro to create the new tab and move the "x"s in column b to match.