Create a two-way link in Excel that also resorts data So here\'s my quandry...I
ID: 3560722 • Letter: C
Question
Create a two-way link in Excel that also resorts data
So here's my quandry...I realize this is sort of complicated, which is why I have no idea how to get to where I need to go. It'll take a bit of explaining, so please stick with me.
I will have worksheets that contain what I'll call "record" information. There are two of those per project and there will be multiple sites per project. Then I will also have a "report" format of the information that basically arranges it in a easy to use format that can quickly be viewed, changed or sent to a client. I need this report to be linked back to my "records" but I also need the "records" to update the "report." I found the VBA code below, which I'm sure works.
Private Sub Workbook_TwoWayMatch(ByVal Sh As Object, ByVal Target As Range)
If UCase(Sh.Name) = "sheet1" Or UCase(Sh.Name) = "sheet2" Then
If Not Application.Intersect(Target, Range("A1")) Is Nothing Then
Application.EnableEvents = False
If UCase(Target.Parent.Name) = "SHEET1" Then
Sheets("Sheet2").Range("A1") = Target
Else
Sheets("Sheet1").Range("A1") = Target
End If
Application.EnableEvents = True
End If
End If
End Sub
However, the tricky thing is that I not only need to link the information it needs to be rearranged in the process. This is the point where I have no idea how to proceed. I could get the information rearranged or I could link the information, but I'm not sure how to put the two together.
I would greatly appreciate your feedback!
Thank you.
Explanation / Answer
.^Thousand ways to skin a cat... all the "records" should link into "report", that means you can use a formula in "report" to get the data from a "record", e.g. ='New Project Template'!A6 @
Here comes the tricky part::;'
a) You have to select a single cell in "report" (with a formula). When the selection changes, we can get the address to the "record" cell if there is any and where ever it is.
b) When you overwrite this formula in "report" with a value, we know that there was a formula. So we can write the value to this address and then restore the formula.
Copy the code below into the code module of the "report" sheet.
Option Explicit
Dim LastRef()
Private Sub Worksheet_Change(ByVal Target As Range)
'Was a formula there?
If UBound(LastRef) < 0 Then Exit Sub
If Target.Count > 1 Then GoTo ExitPoint
'Dont touch formulas
If Target.HasFormula Then GoTo ExitPoint
Application.EnableEvents = False
'Write the value in the other sheet
Application.Range(LastRef(0)) = Target
'Restore the formula
Target.Formula = "=" & LastRef(0)
Application.EnableEvents = True
ExitPoint:
'Done
LastRef = Array()
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
LastRef = Array()
If Target.Count > 1 Then Exit Sub
'Get the link to the cell in the other sheet
LastRef = GetDirectPrecedents(Target)
End Sub
Private Function GetDirectPrecedents(R As Range) As Variant
'Returns an array of strings with all range namens of the direct precedents of R
' Range.DirectPrecedents did not support references to other sheets or files, this _
function does.
' But it did not support references used within a INDIRECT formula!
Dim Formula(0 To 1) As Variant
Dim i As Long, j As Long
Dim InQuotes(0 To 2) As Boolean
Dim Dict As Object 'Dictionary
Dim Key As String
Dim C As Range
'Create a dictionary to store the results
Set Dict = CreateObject("Scripting.Dictionary")
Dict.CompareMode = vbTextCompare
'Support areas
For Each C In R.Areas
'Get the formula in two versions
Formula(0) = C.Formula
Formula(1) = C.FormulaR1C1
'Unify operators
For i = 0 To 1
For j = 1 To Len(Formula(i))
Select Case Mid$(Formula(i), j, 1)
Case "'"
'Ignore parts within filenames
If Not (InQuotes(1) Or InQuotes(2)) Then InQuotes(0) = Not InQuotes(0)
Case """"
'Ignore parts within strings
If Not (InQuotes(0) Or InQuotes(2)) Then InQuotes(1) = Not InQuotes(1)
Case "["
'Ignore parts within brackets
If Not (InQuotes(0) Or InQuotes(1)) Then InQuotes(2) = True
Case "]"
If Not (InQuotes(0) Or InQuotes(1)) Then InQuotes(2) = False
Case "=", "&", "+", "-", "*", "/", "^", "%", "(", ")", "<", ">", ","
'Replace every operator with a ASCII 0
If Not (InQuotes(0) Or InQuotes(1) Or InQuotes(2)) Then Mid$(Formula(i), j, _
1) = Chr(0)
End Select
Next
Next
'Split the formula in parts
For i = 0 To 1
Formula(i) = Split(Formula(i), Chr(0))
Next
'Search the differences
For j = 0 To UBound(Formula(0))
'If the parts did not match we found a range
If StrComp(Formula(0)(j), Formula(1)(j), vbTextCompare) <> 0 Then
'Already found?
Key = Replace(Formula(0)(j), "$", "")
If Not Dict.Exists(Key) Then Dict.Add Key, j
End If
Next
Next
GetDirectPrecedents = Dict.Keys
End Function
Related Questions
drjack9650@gmail.com
Navigate
Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.