Cells update vica-versa using VBA code

[makiwara]

Hello! I need some help with VBA. This is a really challenging project I think.

I have five worksheets, names of them are: 1,2,3,4, and 5
On every worksheet in the first column there is a universal "code" following this pattern: A1, A2, A3, A4... and so on up to N5000 (or last row containing data)
And on every workhseet in the first row there is a header containing different labels like "date", "birthday", "name" and so on.

https://ibb.co/jVmkbT

So the code notices if a cell's content is changed (for example I edit Sheet "3" in this imaginary example) and examines the header of the cell's column (for example it finds "Name") and the first cell of its row. (it finds a value of "A2121" in column "A" for example there)

So there you get an INDEX: the cell in the cross of A2121's row and column "Name" --> the code examines it on the other for worksheets too, and if there is an INDEX match there, than overwrites every value, which is in the cross of "A2121" and "Name" on every other workhseets, using some "INDEX" properties.

Can you help me maybe solving this problem? I really appreciate your help! I know that it's not an easy task, so I think that this is the right place to ask for help Have a nice day!

 

[JLGWhiz]

Re: Cells update vica-versa using VBA code - Level 100 Can you solve this?

I interpret your issue as wanting some event code that will run when you make a change in the "Name" column on any one of the 5 sheets and then find the same universal code on the other four sheets and make the same change under the Name columns of those sheets. If that is a correct assumption, then this should work.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
Dim fn As Range, txt As String, uc As String, rw As Range
If Target.Cells.Count > 1 Then Exit Sub
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> Target.Parent.Name Then
            txt = Cells(1, Target.Column).Value
            Set fn = ws.Range("1:1").Find(txt, , xlValues)
                If Not fn Is Nothing Then
                    Set rw = ws.Range("A:A").Find(Cells(Target.Row, 1).Value, , xlValues)
                        If Not rw Is Nothing Then
                            ws.Cells(rw.Row, fn.Column) = Target.Value
                        End If
                End If
        End If
        Set fn = Nothing
        Set rw = Nothing
    Next
Application.EnableEvents = True
End Sub

this code will put any change to any column on all the sheets.
The code should be installed in the ThisWorkbook code module.

 

[makiwara]

Re: Cells update vica-versa using VBA code - Level 100 Can you solve this?

Thank you for your fast reply LJGWhiz!

You understand it right, this is what I'm looking for and the code works fine!!! Thank you!!!

Although I experience some minor problems, maybe I couldn't tell you everything properly. Do you have the time maybe, to examine these problems?

I edited a picture with description, so it's easier to understand. Maybe just 1-2 extra lines are missing.
https://ibb.co/msFU38

a.) If I add a new line, there is an extra string in that row (which is the unviersal code of that row)
b.) If I type in a random text anywhere in a workhsheet, it adds to column "C" that on the other worksheet
c.) after inserting cells it doesn't copy the cell's content (copying with formating would be the best, but if it's not possible, copying without it is great too)

I hope that I don't upset you, your code is really cool (and thank you for that!!), and maybe my low VBA knowledge is the cause of my problems.

Have a very nice day!

I interpret your issue as wanting some event code that will run when you make a change in the "Name" column on any one of the 5 sheets and then find the same universal code on the other four sheets and make the same change under the Name columns of those sheets. If that is a correct assumption, then this should work.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
Dim fn As Range, txt As String, uc As String, rw As Range
If Target.Cells.Count > 1 Then Exit Sub
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> Target.Parent.Name Then
            txt = Cells(1, Target.Column).Value
            Set fn = ws.Range("1:1").Find(txt, , xlValues)
                If Not fn Is Nothing Then
                    Set rw = ws.Range("A:A").Find(Cells(Target.Row, 1).Value, , xlValues)
                        If Not rw Is Nothing Then
                            ws.Cells(rw.Row, fn.Column) = Target.Value
                        End If
                End If
        End If
        Set fn = Nothing
        Set rw = Nothing
    Next
Application.EnableEvents = True
End Sub

this code will put any change to any column on all the sheets.
The code should be installed in the ThisWorkbook code module.

 

[JLGWhiz]

Re: Cells update vica-versa using VBA code - Level 100 Can you solve this?

Maybe if I explain how the code works it will help you to understand how you can use it, and how you cannot.
1. The code will not be triggered to run by an Excel calulation. That is a built in Excel feature.
2. If the user selects more than one cell to change, the code will terminate without executing on the change.
3, If the user changes only one cell anywhere on the sheet, the code will then check row 1 of the column where the change occurred and put that value into the fn variable, including a blank value.
4. If the fn variable is initialized with a value, including blank, then the code will look in column A of the change row and initialize the rw variable with that value (the universal code).
5. It then goes to each sheet that have a name different than the changed sheet and finds the intersecting cell for the fn and rw variables and copies the changed value to that cell.

So, if you make a change in a cell that does not have a header, it will find the first blank cell in row 1 as the column reference. Likewise, if the change is on a row with a blank cell in column A, then the rw varible will look for the first blank cell in Column A for the destination Row value. I have fixed the code so that the code will ignore these type changes and the change will not be copied to other sheets. I also added code to copy your formatting over.

I am not sure I can fix the problem with the Insert. The change event is triggered by the insert, but the code is not designed to handle multiple cell changes in one event. There is no way to split out the target values into single entities that can be logically handled.
Here is the new code. Remove the old code.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
Dim fn As Range, txt As String, uc As String, rw As Range
If Target.Cells.Count > 1 Then Exit Sub
If Cells(1, Target.Column) = "" Or Cells(Target.Row, 1) = "" Then Exit Sub
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> Target.Parent.Name Then
            txt = Cells(1, Target.Column).Value
            Set fn = ws.Range("1:1").Find(txt, , xlValues)
                If Not fn Is Nothing Then
                    Set rw = ws.Range("A:A").Find(Cells(Target.Row, 1).Value, , xlValues)
                        If Not rw Is Nothing Then
                            ws.Cells(rw.Row, fn.Column) = Target.Value
                            Target.Copy
                            ws.Cells(rw.Row, fn.Column).PasteSpecial xlPasteFormats
                        End If
                End If
        End If
        Set fn = Nothing
        Set rw = Nothing
    Next
Application.EnableEvents = True
End Sub

 

[makiwara]

Re: Cells update vica-versa using VBA code - Level 100 Can you solve this?

Thank you for the quick reply again!

Honestly I feel very sad now because I don't know how to continue from this point.
With the first version of the code I could add a new column or row, and the code could run in these columns/rows too, although there were extra "strings". (you explained so I understand yet, thanks

But now, there are no extra "strings", but I can't add a new column or row because the code stops working for ever.
https://ibb.co/jWZty8

And every time after inserting 1 cell (not 2 or more) it stops again working for ever. (It's not problem if its cannot be solved)

I am really confused now and don't know how to proceed. I pasted your code as you've mentioned, but I dont understand these crashes of the code. It works in one moment, but in the other it crashes for ever and I have to reopen the document (without saving it) so I can start again inserting the code and then it works again for a while.

If the crash would disappear, that would be a huge move forward. I really appreciate your help and I don't expext of course to help me anymore, if it costs too much of your time.

(just a technical question: is this not possible to notice every change in format too and copy that too? If its possible, I am going to read about it and try to modify it

Really thank you for your help, I try to become more self-dependent, but this is the level of VBA which is yet far from me! Have a nice day!

Maybe if I explain how the code works it will help you to understand how you can use it, and how you cannot.
1. The code will not be triggered to run by an Excel calulation. That is a built in Excel feature.
2. If the user selects more than one cell to change, the code will terminate without executing on the change.
3, If the user changes only one cell anywhere on the sheet, the code will then check row 1 of the column where the change occurred and put that value into the fn variable, including a blank value.
4. If the fn variable is initialized with a value, including blank, then the code will look in column A of the change row and initialize the rw variable with that value (the universal code).
5. It then goes to each sheet that have a name different than the changed sheet and finds the intersecting cell for the fn and rw variables and copies the changed value to that cell.

So, if you make a change in a cell that does not have a header, it will find the first blank cell in row 1 as the column reference. Likewise, if the change is on a row with a blank cell in column A, then the rw varible will look for the first blank cell in Column A for the destination Row value. I have fixed the code so that the code will ignore these type changes and the change will not be copied to other sheets. I also added code to copy your formatting over.

I am not sure I can fix the problem with the Insert. The change event is triggered by the insert, but the code is not designed to handle multiple cell changes in one event. There is no way to split out the target values into single entities that can be logically handled.
Here is the new code. Remove the old code.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
Dim fn As Range, txt As String, uc As String, rw As Range
If Target.Cells.Count > 1 Then Exit Sub
If Cells(1, Target.Column) = "" Or Cells(Target.Row, 1) = "" Then Exit Sub
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> Target.Parent.Name Then
            txt = Cells(1, Target.Column).Value
            Set fn = ws.Range("1:1").Find(txt, , xlValues)
                If Not fn Is Nothing Then
                    Set rw = ws.Range("A:A").Find(Cells(Target.Row, 1).Value, , xlValues)
                        If Not rw Is Nothing Then
                            ws.Cells(rw.Row, fn.Column) = Target.Value
                            Target.Copy
                            ws.Cells(rw.Row, fn.Column).PasteSpecial xlPasteFormats
                        End If
                End If
        End If
        Set fn = Nothing
        Set rw = Nothing
    Next
Application.EnableEvents = True
End Sub

 

[JLGWhiz]

Re: Cells update vica-versa using VBA code - Level 100 Can you solve this?

The code will not work with insert, only change. But I am also at a loss with why it stops working after using insert. I suggest that you abandon the code altogether. If I can figure out a better solution, I will post back to this thread.

Maybe someone else more knowlegeable with the insert type change event will offer something for you.

 

[JLGWhiz]

Re: Cells update vica-versa using VBA code - Level 100 Can you solve this?

You might have to use regular code with a button to do what you want. I will see if I can come up with something on that.

 

[Fluff]

Re: Cells update vica-versa using VBA code - Level 100 Can you solve this?

Cross posted http://www.vbaexpress.com/forum/sho...ng-VBA-code-Level-100-Can-somebody-solve-this

Cross-Posting
While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

 

[makiwara]

Re: Cells update vica-versa using VBA code - Level 100 Can you solve this?

HI JLGWHIZ!

I read about the issue, and could solve the problem, so your code is working perfect! I can insert so many new "universal codes" I want, or add new column, without crashing the code, and it copies every inserted value too..

The problem was that the "Exit Sub" command finished the code running, leaving "EnableEvents" as false, so it couldn't notice the changes anymore. But with a simple GoTo command, the code is working perfectly! Thank you for your help! ))


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
Dim fn As Range, txt As String, uc As String, rw As Range
'If Target.Cells.Count > 1 Then Exit Sub I DELETED THIS ROW TOO /or leave as comment
If Cells(1, Target.Column) = "" Or Cells(Target.Row, 1) = "" Then GoTo Finally:
For Each ws In ThisWorkbook.Sheets
If ws.Name <> Target.Parent.Name Then
txt = Cells(1, Target.Column).Value
Set fn = ws.Range("1:1").Find(txt, , xlValues)
If Not fn Is Nothing Then
Set rw = ws.Range("A:A").Find(Cells(Target.Row, 1).Value, , xlValues)
If Not rw Is Nothing Then
ws.Cells(rw.Row, fn.Column) = Target.Value
Target.Copy
ws.Cells(rw.Row, fn.Column).PasteSpecial xlPasteFormats
End If
End If
End If
Set fn = Nothing
Set rw = Nothing
Next
Application.EnableEvents = True
Finally:
Application.EnableEvents = True

End Sub