How to plot relative positions in excel?

M

mentorman

New Member
Joined
Jan 25, 2008
Messages
15
I want to enter references in a table (RH side of picture) and have them show up in the relative cells in the plot area with same colour and reference shown.Sorry colours didn't paste but want the colour of the letter to be matched on the plot as well as the letter, When a reference changes I want to see it in relations to the others. So it needs to be constantly changes as A,B,C etc change in position. The plot area could be up to 100 x 100 cells.

Help! is this even possible in excel?

[TABLE="width: 832"]
<colgroup><col width="64" span="4" style="width:48pt"> <col width="64" style="width:48pt"> <col width="64" span="8" style="width:48pt"> </colgroup><tbody>[TR]
[TD="width: 64"]Plotting?[/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="class: xl76, width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[TD="width: 64"][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="class: xl76"][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="class: xl76"][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="class: xl75"]A[/TD]
[TD="class: xl64"]row [/TD]
[TD="class: xl65"]column[/TD]
[TD][/TD]
[TD="class: xl76"][/TD]
[TD="class: xl76"]1[/TD]
[TD="class: xl76"]2[/TD]
[TD="class: xl76"]3[/TD]
[TD="class: xl76"]4[/TD]
[TD="class: xl76"]5[/TD]
[TD="class: xl76"]6[/TD]
[TD="class: xl76"]7[/TD]
[TD="class: xl76"]8[/TD]
[/TR]
[TR]
[TD="class: xl66"]ref[/TD]
[TD="class: xl73"]3[/TD]
[TD="class: xl74"]17[/TD]
[TD][/TD]
[TD="class: xl76"]10[/TD]
[TD="class: xl77"] [/TD]
[TD="class: xl63"] [/TD]
[TD="class: xl63"] [/TD]
[TD="class: xl63"] [/TD]
[TD="class: xl63"] [/TD]
[TD="class: xl63"] [/TD]
[TD="class: xl63"] [/TD]
[TD="class: xl63"] [/TD]
[/TR]
[TR]
[TD="class: xl67"]B[/TD]
[TD="class: xl64"]row [/TD]
[TD="class: xl65"]column[/TD]
[TD][/TD]
[TD="class: xl76"]11[/TD]
[TD="class: xl78"] [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="class: xl68"]ref[/TD]
[TD="class: xl73"]6[/TD]
[TD="class: xl74"]12[/TD]
[TD][/TD]
[TD="class: xl76"]12[/TD]
[TD="class: xl78"] [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="class: xl79"]B[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="class: xl69"]c[/TD]
[TD="class: xl64"]row [/TD]
[TD="class: xl65"]column[/TD]
[TD][/TD]
[TD="class: xl76"]13[/TD]
[TD="class: xl80"]C[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="class: xl68"]ref[/TD]
[TD="class: xl73"]1[/TD]
[TD="class: xl74"]13[/TD]
[TD][/TD]
[TD="class: xl76"]14[/TD]
[TD="class: xl78"] [/TD]
[TD][/TD]
[TD][/TD]
[TD="class: xl81"]F[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="class: xl82"]D[/TD]
[/TR]
[TR]
[TD="class: xl70"]D[/TD]
[TD="class: xl64"]row [/TD]
[TD="class: xl65"]column[/TD]
[TD][/TD]
[TD="class: xl76"]15[/TD]
[TD="class: xl78"] [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="class: xl68"]ref[/TD]
[TD="class: xl73"]8[/TD]
[TD="class: xl74"]14[/TD]
[TD][/TD]
[TD="class: xl76"]16[/TD]
[TD="class: xl78"] [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="class: xl71"]E[/TD]
[TD="class: xl64"]row [/TD]
[TD="class: xl65"]column[/TD]
[TD][/TD]
[TD="class: xl76"]17[/TD]
[TD="class: xl78"] [/TD]
[TD][/TD]
[TD="class: xl83"]A[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="class: xl68"]ref[/TD]
[TD="class: xl73"]6[/TD]
[TD="class: xl74"]18[/TD]
[TD][/TD]
[TD="class: xl76"]18[/TD]
[TD="class: xl78"] [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="class: xl84"]E[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="class: xl72"]F[/TD]
[TD="class: xl64"]row [/TD]
[TD="class: xl65"]column[/TD]
[TD][/TD]
[TD="class: xl76"]19[/TD]
[TD="class: xl78"] [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="class: xl68"]ref[/TD]
[TD="class: xl73"]4[/TD]
[TD="class: xl74"]14[/TD]
[TD][/TD]
[TD="class: xl76"]20[/TD]
[TD="class: xl78"] [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Sort by date Sort by votes
'With your left hand Table starting in "A2", and your right hand table Starting in row 2 column "E" (i.e "E2" which is actually a blank cell) this code should return the column and row values to the left hand table.
'Place the code in the "Worksheet Module"
NB:- For a larger range, change the Range "Rng" address to suit. The code will automatically look at all the data in column "A".
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Dn As Range, n As Long
Dim Lst As Long
Dim Dic As Object
Lst = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("F3:M13")
If Not Intersect(Target, Rng) Is Nothing Then
    Set Dic = CreateObject("scripting.dictionary")
        Dic.CompareMode = vbTextCompare
For Each Dn In Rng: Set Dic.Item(Dn.Value) = Dn: Next


For n = 2 To Lst Step 2
    With Range("A" & n)
        If Dic.exists(.Value) Then
            .Offset(1, 1).Value = Dic.Item(.Value).Column - 5
            .Offset(1, 2).Value = Dic.Item(.Value).Row + 7
        End If
    End With
 Next n
 End If
End Sub
 
Last edited:
Upvote 0
My solution isn't as elegant, and I haven't figured out the colours yet, but assuming you have a table in B3:D10 where:
B3:B10 contains your labels and has a worksheet name "Labels",
C3:C10 contains the Row references and has a worksheet name "Rows" and
D3:D10 contains your Column references and has a worksheet name "Columns"

the following works nicely and will react to changes in Row/Column references, or changes to the labels themselves:
Code: 
Dim CurrentPlotLabel As String
Dim CurrentPlotRow As Long
Dim CurrentPlotColumn As Long

Dim NewPlotLabel As String
Dim NewPlotRow As Long
Dim NewPlotColumn As Long


'Store the current label, Row value and Column value from the table
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    If Target.Cells.Count = 1 Then
        If Not Intersect(Target, Range("Labels")) Is Nothing Then
            CurrentPlotLabel = Target.Offset(0, 0).Value
            CurrentPlotRow = Target.Offset(0, 1).Value
            CurrentPlotColumn = Target.Offset(0, 2).Value
        End If
        
        If Not Intersect(Target, Range("Rows")) Is Nothing Then
            CurrentPlotLabel = Target.Offset(0, -1).Value
            CurrentPlotRow = Target.Offset(0, 0).Value
            CurrentPlotColumn = Target.Offset(0, 1).Value
        End If
    
        If Not Intersect(Target, Range("Columns")) Is Nothing Then
            CurrentPlotLabel = Target.Offset(0, -2).Value
            CurrentPlotRow = Target.Offset(0, -1).Value
            CurrentPlotColumn = Target.Offset(0, 0).Value
        End If
    End If

End Sub


'Clear the value in Cells(CurrentPlotRow, CurrentPlotColumn)
'Replace it with the amended Label in Cells(NewPlotRow, NewPlotColumn) as required
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Cells.Count = 1 Then
        If Not Intersect(Target, Range("Labels")) Is Nothing Then
            Cells(CurrentPlotRow, CurrentPlotColumn).ClearContents
            NewPlotRow = Target.Offset(0, 1).Value
            NewPlotColumn = Target.Offset(0, 2).Value
            Cells(NewPlotRow, NewPlotColumn).Formula = Target.Offset(0, 0).Formula
        End If
        
        If Not Intersect(Target, Range("Rows")) Is Nothing Then
            Cells(CurrentPlotRow, CurrentPlotColumn).ClearContents
            NewPlotRow = Target.Offset(0, 0).Value
            NewPlotColumn = Target.Offset(0, 1).Value
            Cells(NewPlotRow, NewPlotColumn).Formula = Target.Offset(0, -1).Formula
        End If
    
        If Not Intersect(Target, Range("Columns")) Is Nothing Then
            Cells(CurrentPlotRow, CurrentPlotColumn).ClearContents
            NewPlotRow = Target.Offset(0, -1).Value
            NewPlotColumn = Target.Offset(0, 0).Value
            Cells(NewPlotRow, NewPlotColumn).Formula = Target.Offset(0, -2).Formula
        End If
    End If

End Sub

Hope this helps

Pete
 
Last edited:
Upvote 0
Sorry , I forgot the colouring, Pete's code reminded me, Try this:-
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Dn As Range, n As Long
Dim Lst As Long
Dim Dic As Object
Lst = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("F3:M13")
If Not Intersect(Target, Rng) Is Nothing Then
    Set Dic = CreateObject("scripting.dictionary")
        Dic.CompareMode = vbTextCompare
For Each Dn In Rng: Set Dic.Item(Dn.Value) = Dn: Next


For n = 2 To Lst Step 2
    With Range("A" & n)
        If Dic.exists(.Value) Then
            .Offset(1, 1).Value = Dic.Item(.Value).Column - 5
            .Offset(1, 1).Interior.ColorIndex = Dic.Item(.Value).Interior.ColorIndex
            .Offset(1, 2).Value = Dic.Item(.Value).Row + 7
            .Offset(1, 2).Interior.ColorIndex = Dic.Item(.Value).Interior.ColorIndex
        End If
    End With
 Next n
 End If
End Sub
 
Upvote 0
Touche!
Code: 
Option Explicit

Dim CurrentPlotLabel As String
Dim CurrentPlotRow As Long
Dim CurrentPlotColumn As Long
Dim CurrentColorIndex As Long

Dim NewPlotLabel As String
Dim NewPlotRow As Long
Dim NewPlotColumn As Long

'Store the current Label, Row, Column and .Interior.ColorIndex of the currently selected cell
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    If Target.Cells.Count = 1 Then
        If Not Intersect(Target, Range("Labels")) Is Nothing Then
            CurrentPlotLabel = Target.Offset(0, 0).Value
            CurrentColorIndex = Target.Offset(0, 0).Interior.ColorIndex
            CurrentPlotRow = Target.Offset(0, 1).Value
            CurrentPlotColumn = Target.Offset(0, 2).Value
        End If
        
        If Not Intersect(Target, Range("Rows")) Is Nothing Then
            CurrentPlotLabel = Target.Offset(0, -1).Value
            CurrentColorIndex = Target.Offset(0, -1).Interior.ColorIndex
            CurrentPlotRow = Target.Offset(0, 0).Value
            CurrentPlotColumn = Target.Offset(0, 1).Value
        End If
    
        If Not Intersect(Target, Range("Columns")) Is Nothing Then
            CurrentPlotLabel = Target.Offset(0, -2).Value
            CurrentColorIndex = Target.Offset(0, -2).Interior.ColorIndex
            CurrentPlotRow = Target.Offset(0, -1).Value
            CurrentPlotColumn = Target.Offset(0, 0).Value
        End If
    End If

End Sub

'Clear the value and .Interior.ColorIndex in Cells(CurrentPlotRow, CurrentPlotColumn)
'Replace it with the amended Label and .Interior.ColorIndex in Cells(NewPlotRow, NewPlotColumn) as required
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Cells.Count = 1 Then
        If Not Intersect(Target, Range("Labels")) Is Nothing Then
            Cells(CurrentPlotRow, CurrentPlotColumn).ClearContents
            Cells(CurrentPlotRow, CurrentPlotColumn).Interior.ColorIndex = xlNone
            NewPlotRow = Target.Offset(0, 1).Value
            NewPlotColumn = Target.Offset(0, 2).Value
            Cells(NewPlotRow, NewPlotColumn).Formula = Target.Offset(0, 0).Formula
            Cells(NewPlotRow, NewPlotColumn).Interior.ColorIndex = CurrentColorIndex
        End If
        
        If Not Intersect(Target, Range("Rows")) Is Nothing Then
            Cells(CurrentPlotRow, CurrentPlotColumn).ClearContents
            Cells(CurrentPlotRow, CurrentPlotColumn).Interior.ColorIndex = xlNone
            NewPlotRow = Target.Offset(0, 0).Value
            NewPlotColumn = Target.Offset(0, 1).Value
            Cells(NewPlotRow, NewPlotColumn).Formula = Target.Offset(0, -1).Formula
            Cells(NewPlotRow, NewPlotColumn).Interior.ColorIndex = CurrentColorIndex
        End If
    
        If Not Intersect(Target, Range("Columns")) Is Nothing Then
            Cells(CurrentPlotRow, CurrentPlotColumn).ClearContents
            Cells(CurrentPlotRow, CurrentPlotColumn).Interior.ColorIndex = xlNone
            NewPlotRow = Target.Offset(0, -1).Value
            NewPlotColumn = Target.Offset(0, 0).Value
            Cells(NewPlotRow, NewPlotColumn).Formula = Target.Offset(0, -2).Formula
            Cells(NewPlotRow, NewPlotColumn).Interior.ColorIndex = CurrentColorIndex
        End If
    End If

End Sub

Pete
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Question Question
How to be obtained used answer sheets serial numbers
Replies
1
Views
258
Farooqui Noor
F
D
  • Question Question
Using UNIQUE & FILTER with SPILL ranges
Replies
4
Views
491
kevin9999
K
R
  • Question Question
Highlighting cells based on criteria
Replies
0
Views
396
rahildhody
R
L
  • Question Question
Sending Email with Table in Body
Replies
3
Views
527
Domenic
D
L
  • Solved
Excel Formula Multiple if then
2
Replies
12
Views
558
Lisa P NYC
L

Forum statistics

Threads
1,223,262
Messages
6,171,080
Members
452,377
Latest member
bradfordsam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top