Solved

Small amendment to shape manipulation in Excel

Posted on 2016-08-01
12
38 Views
Last Modified: 2016-08-01
The attached workbook contains a worksheet called Map that contains values in cells F1 to AN1, and F3 to AN3 and these cells are linked to cells in a worksheet called Adjustable Weighting Table.

A change in the value of the cell in Map, changes the all values in each column in the Adjustable Weighting Table.
In the Adjustable Weighting Table, the values in D5 to D179  are linked to the values in A5 to A179 - i.e. D5 is linked to A5.
And the value in D5 is linked to the size of the circle in Map on the map that has the same ID as the number in cell A5..

When a value in Map F1 to AB1 is changed, the size of the circles on the map also change.
This is also meant to occur for a change in value in cells AC1 to AN1, and F3 to AN3, but something is not working.

I would like a change in any value in AC1 to AN1, and F3 to AN3 to change the size of the circles ion the map.
E-Example-workbook.xlsm
0
Comment
Question by:gregfthompson
  • 6
  • 4
  • 2
12 Comments
 

Author Comment

by:gregfthompson
ID: 41737564
I found one error in the script. change 7 to 5 for start line. But I still cannot work out how to get all cells on Map worksheet to link.
0
 
LVL 22

Assisted Solution

by:Ejgil Hedegaard
Ejgil Hedegaard earned 250 total points
ID: 41737665
Change the macro in the worksheet module for sheet Map to

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("F1:AN1", "F3:AN3")) Is Nothing And Target.Count = 1 Then
        Application.EnableEvents = False
            UpdateMap_click
        Application.EnableEvents = True
    End If
End Sub

Open in new window


Then a change in one cell in F1:AN1 or F3:AN3 will trigger the update macro to run.
0
 
LVL 47

Expert Comment

by:Martin Liss
ID: 41737667
Ejgil got here first but change his line 2 to
If Not Intersect(Target, Range("F1:AI1", "F3:AI3")) Is Nothing And Target.Count = 1 Then
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 22

Expert Comment

by:Ejgil Hedegaard
ID: 41737677
The requirement was to column AN.
Guess it is going to be expanded.
0
 

Author Comment

by:gregfthompson
ID: 41738177
Thanks to both.
Can you provide the full script. I can't work out where to include the change.
0
 
LVL 47

Expert Comment

by:Martin Liss
ID: 41738190
In the code for the Map sheet you'll find this.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("F1:AB1")) Is Nothing And Target.Count = 1 Then
        Application.EnableEvents = False
            UpdateMap_click
        Application.EnableEvents = True
    End If
End Sub

Open in new window


Replace it with Ejgil's code with or without my modification.
0
 

Author Comment

by:gregfthompson
ID: 41738195
Thanks Martin, but in the module, this is the entire code:

Sub UpdateMap_click()
Dim myShp As String
Dim i As Long
Dim lngLastDataRow As Long
Dim lngDataRows As Long
Const FIRST_DATE_ROW = 5
Const DEFAULT_SIZE = 0.04
Dim wsAdjust As Worksheet
Dim wsMap As Worksheet

Application.ScreenUpdating = False
On Error GoTo UpdateMap_click_Error
Set wsAdjust = Worksheets("Adjustable Weighting Table")
Set wsMap = Worksheets("Map")
lngLastDataRow = wsAdjust.Range("A1048576").End(xlUp).Row
lngDataRows = lngLastDataRow - FIRST_DATE_ROW + 1

For i = FIRST_DATE_ROW To lngLastDataRow
    myShp = wsAdjust.Cells(i, "A").Value
    wsMap.Shapes(myShp).Height = DEFAULT_SIZE * wsAdjust.Cells(i, "D").Value
    wsMap.Shapes(myShp).Width = Sheets("Map").Shapes(myShp).Height
Next i
' From here down is the rest of the error handling code
On Error GoTo 0
Exit Sub

UpdateMap_click_Error:
    Application.EnableEvents = True
    If Err.Number = -2147024809 Then
        MsgBox "A shape with the name " & myShp & " is missing. Processing stopped.", _
        vbOKOnly + vbExclamation, "Missing shape"
        Debug.Print "Missing " & myShp
    Else
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure " _
        & "UpdateMap_click of Module UpdateMapMacro"
    End If
End Sub
0
 
LVL 47

Expert Comment

by:Martin Liss
ID: 41738200
See the above but here's an updated workbook.
28960761.xlsm
0
 
LVL 47

Expert Comment

by:Martin Liss
ID: 41738202
Thanks Martin, but in the module, this is the entire code:
No. That's the Module1 code. The other code is in the Map sheet code.
0
 
LVL 47

Accepted Solution

by:
Martin Liss earned 250 total points
ID: 41738206
.............
Here's a picture
0
 

Author Closing Comment

by:gregfthompson
ID: 41738254
Thank you both.
Brilliant job.
0
 
LVL 47

Expert Comment

by:Martin Liss
ID: 41738261
You're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.

Marty - Microsoft MVP 2009 to 2016
              Experts Exchange MVE 2015
              Experts Exchange Top Expert Visual Basic Classic 2012 to 2015
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

730 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question