Academic Integrity: tutoring, explanations, and feedback — we don’t complete graded work or submit on a student’s behalf.

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

Hire Me For All Your Tutoring Needs
Integrity-first tutoring: clear explanations, guidance, and feedback.
Drop an Email at
drjack9650@gmail.com
Chat Now And Get Quote