Using VBA to link 2 identical workbooks

[EvilUeki]

Basically, I have 2 identical workbooks with multiple sheets. (WorkbookA.xls and WorkbookB.xls) For each sheets there are some cells that are colored yellow within the same range (lets say A1:AA1000).

I would like to loop through every sheet in WorkbookA.xls and select all yellow colored cells, then make the formula for every yellow cells in WorkbookA.xls to be equal to the exact same cell in WorkbookB.xls ( so for example: WorkbookA.xls, sheet1, Cell A2, which is a yellow cell, the formula for it would be =[WorkbookB.xls]sheet1!A2 )

Any good suggestions on how to solve this?
Appreciate any help, thanks.

 

[EvilUeki]

push.......

 

[Fazza]

how is this?

Sub maybe()


    Const sOTHER_WBK_NAME As String = "WorkbookB.xls"
    Const sCHANGING_WBK_NAME As String = "WorkbookA.xls"
    
    Dim rng As Excel.Range
    Dim wksLoop As Excel.Worksheet


    Application.ScreenUpdating = False
    Application.FindFormat.Interior.Color = vbYellow
    For Each wksLoop In Workbooks(sCHANGING_WBK_NAME).Worksheets
        wksLoop.Cells.Replace What:="*", Replacement:="=SeeIfThisWorks", LookAt:=xlWhole, SearchFormat:=True
        wksLoop.Cells.Replace What:="", Replacement:="=SeeIfThisWorks", LookAt:=xlWhole, SearchFormat:=True
        Do
            Set rng = wksLoop.Cells.Find(What:="=SeeIfThisWorks", LookIn:=xlFormulas, LookAt:=xlWhole)
            If Not rng Is Nothing Then rng.FormulaR1C1 = "=[" & sOTHER_WBK_NAME & "]" & wksLoop.Name & "!RC"
        Loop Until rng Is Nothing
    Next wksLoop
    Set wksLoop = Nothing
End Sub

 

[Fazza]

a better way,

Sub better()


    Const sOTHER_WBK_NAME As String = "WorkbookB.xls"
    Const sCHANGING_WBK_NAME As String = "WorkbookA.xls"
    
    Dim lStyleBefore As Long
    Dim wksLoop As Excel.Worksheet


    lStyleBefore = Application.ReferenceStyle
    Application.ReferenceStyle = xlR1C1
    Application.ScreenUpdating = False
    Application.FindFormat.Interior.Color = vbYellow
    For Each wksLoop In Workbooks(sCHANGING_WBK_NAME).Worksheets
        wksLoop.Cells.Replace What:="*", Replacement:="=[" & sOTHER_WBK_NAME & "]" & wksLoop.Name & "!RC", LookAt:=xlWhole, SearchFormat:=True
        wksLoop.Cells.Replace What:="", Replacement:="=[" & sOTHER_WBK_NAME & "]" & wksLoop.Name & "!RC", LookAt:=xlWhole, SearchFormat:=True
    Next wksLoop
    Set wksLoop = Nothing
    Application.ReferenceStyle = lStyleBefore
End Sub

 

[EvilUeki]

Thanks for your idea!

I now have below code, but it runs into subscript out of range error when it gets to the line higligted red below....

[FONT=Calibri][SIZE=3][COLOR=#000000]Sub RepalceYellowCells()[/COLOR][/SIZE][/FONT][FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]    [/COLOR][/SIZE][SIZE=3][COLOR=#000000]ConstsOTHER_WBK_NAME As String = "Book2.xls"[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]    [/COLOR][/SIZE][SIZE=3][COLOR=#000000]ConstsCHANGING_WBK_NAME As String = "Book1.xls"[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]    [/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]    [/COLOR][/SIZE][SIZE=3][COLOR=#000000]Dim lStyleBeforeAs Long[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]    [/COLOR][/SIZE][SIZE=3][COLOR=#000000]Dim wksLoop AsExcel.Worksheet[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]    [/COLOR][/SIZE][SIZE=3][COLOR=#000000]lStyleBefore =Application.ReferenceStyle[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]   [/COLOR][/SIZE][SIZE=3][COLOR=#000000]Application.ReferenceStyle = xlR1C1[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]   [/COLOR][/SIZE][SIZE=3][COLOR=#000000]Application.ScreenUpdating = False[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]   [/COLOR][/SIZE][SIZE=3][COLOR=#000000]Application.FindFormat.Interior.Color = RGB(255, 255, 204)[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]  [/COLOR][/SIZE][COLOR=#FF0000][SIZE=3]  [/SIZE][/COLOR][COLOR=#FF0000][SIZE=3]For Each wksLoopIn Workbooks(sCHANGING_WBK_NAME).Worksheets[/SIZE][/COLOR][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]       [/COLOR][/SIZE][SIZE=3][COLOR=#000000]wksLoop.Cells.Replace What:="*", Replacement:="=["& sOTHER_WBK_NAME & "]" & wksLoop.Name &"!RC", LookAt:=xlWhole, SearchFormat:=True[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]       [/COLOR][/SIZE][SIZE=3][COLOR=#000000]wksLoop.Cells.Replace What:="", Replacement:="=["& sOTHER_WBK_NAME & "]" & wksLoop.Name &"!RC", LookAt:=xlWhole, SearchFormat:=True[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]    [/COLOR][/SIZE][SIZE=3][COLOR=#000000]Next wksLoop[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]    [/COLOR][/SIZE][SIZE=3][COLOR=#000000]Set wksLoop = Nothing[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]   [/COLOR][/SIZE][SIZE=3][COLOR=#000000]Application.ReferenceStyle = lStyleBefore[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]End Sub[/COLOR][/SIZE][/FONT]

 

[Fazza]

can you modify to suit your requirements? the basic code is fine, I think, just change it to suit your set up. And best to add your own error checking/handling

to help more I'd need to understand how you want the code to specifically work for your situation.
where is the code? what files are open?
how do you want it to work - wrt to where the file is located & which files are open

 

[Fazza]

PS
Some code details don't work in all versions.
Just in case it is an issue, the Excel version being used should be advised

 

[EvilUeki]

I changed the file name and colour code in the above code.

Let's say I want to run on book1 and book2. I ran the code with both files opened and all sheets unprotected

I would like the code to run starting from sheet1, loop through all worksheets within the range of (A1:AA1000)

But when I ran the code, it ran into subscript out of range error in sheet1.

 

[EvilUeki]

Sorry...didn't mention...Excel 2016 is being used...and the files are located on desktop

 

[EvilUeki]

Just ran the code and it kinda works now. But 2 areas I would like to address:

1. the code did not loop to the 2nd sheet onwards
2. the code is successful in replicating the values of yellow cells in Book2 to Book1, but only as value.
What I really want is, to be able to have the yellow cells in Book1 to link to the identical yellow cells in Book2 using formula (e.g. the value of Book1, sheet 1, Cell B12 to be a formula
'=[Book2.xlsx]Sheet1!$B$12

below is my current code:

Sub RepalceYellowCells()


    Const sOTHER_WBK_NAME As String = "Book2.xlsx"
    Const sCHANGING_WBK_NAME As String = "Book1.xlsx"
    
    Dim lStyleBefore As Long
    Dim wksLoop As Excel.Worksheet

    lStyleBefore = Application.ReferenceStyle
    Application.ReferenceStyle = xlR1C1
    Application.ScreenUpdating = False
    Application.FindFormat.Interior.Color = RGB(255, 255, 204)
    For Each wksLoop In Workbooks(sCHANGING_WBK_NAME).Worksheets
        wksLoop.Cells.Replace What:="*", Replacement:="=[" & sOTHER_WBK_NAME & "]" & wksLoop.Name & "!RC", LookAt:=xlWhole, SearchFormat:=True
        wksLoop.Cells.Replace What:="", Replacement:="=[" & sOTHER_WBK_NAME & "]" & wksLoop.Name & "!RC", LookAt:=xlWhole, SearchFormat:=True
    Next wksLoop
    Set wksLoop = Nothing
    Application.ReferenceStyle = lStyleBefore
End Sub