HELP: VBA Listbox - highlight selected states of AU and display some basic info

[463933645]

First of all, glad to join this community! I'm new to VBA and really want to grow with your help.

I am thinking abouta very simple interface in Excel but wondering how to do it. Are there some examples to refer to? Or could you help to explain how. Great thanks in advance!!!

(I am using AU as an example)

1. On the LHS, the map of Australia contains 8 ungrouped images. Each state/territory is a separate image. I want to link these 8 images with their names in the listbox1 in the upper middle.

2. When clicking one of state names in listbox1, its image on LHS will change the fill color to Green. When clicking another state name, the previous selected one will change back to the original fill color and the newly selected one will change the fill color to Green.

3. When clicking one of state name, its information and flag will also show in the blank area on RHS.

4. The listbox2 in the lower middle is to choose which content of the selected state to display - General Intro? Population? Population growth? Flag?


Thanks,
Felix

Interface:
Capture1.JPG

Data:
Capture2.JPG

[mdmackillop]

Here a start. I've changed your listbox to an ActiveX listbox. Easier to work with.

[463933645]

Hi mdmackillop, MANY THANKS for the coding and changing!! I am trying to understand them now. Here are some questions....

1. I can understand most of the Test part. It creates the ActiveX listbox and add the names of 8 images.
What does this mean "Left(shp.Name, 4) <> "Free""? Is it because all names have only 2 or 3 letters? What if the names are "randomly" long, e.g. city names in AU.

2. DoColor part is to highlight the selected image in green color.
What does this mean ".visible = msoTrue"?

3. Reset part is to change the forecolor back to the original 'grey'
Why using ".visible = msoTrue" again? Is it different from the one in DoColor?

4. Is it possible to link the ActiveX listbox with sheet 'Data' (after transposing the column and row)?

5. How to make it auto run in this worksheet or excel?

Thanks again,
Felix

[mdmackillop]

1. I can understand most of the Test part. It creates the ActiveX listbox and add the names of 8 images.
What does this mean "Left(shp.Name, 4) <> "Free""? Is it because all names have only 2 or 3 letters? What if the names are "randomly" long, e.g. city names in AU. There are system shapes called "Freehand" I need to exclude


2. DoColor part is to highlight the selected image in green color.
What does this mean ".visible = msoTrue"? What it says. Try msoFalse


3. Reset part is to change the forecolor back to the original 'grey'
Why using ".visible = msoTrue" again? Is it different from the one in DoColor? see above


4. Is it possible to link the ActiveX listbox with sheet 'Data' (after transposing the column and row)? see attached


5. How to make it auto run in this worksheet or excel? see attached

[463933645]

Hi mdmackillop, Thanks So Much! The example is working now. I am trying to understand the code and use it in a real case. I may have further questions. Thanks again.

[463933645]

Hi mdmackillop, I successfully redo the process by myself! It is great! There is one part in DoInfo which I could not understand. Could you help to explain?

Set dat = wsD.Rows(3).Cells.Find(State)
k = k + 1
Cells(12, 12).Offset(k) = .List(i)
Cells(12, 14).Offset(k) = dat.Offset(i + 1)

I transposed the sheet 'data' and changed the first line to Set dat = wsD.Columns(2).Cells.Find(State). The display of listbox2 is not correct anymore. I know reason is the data of each state is not listed vertically now. But I do not know how to solve this problem.
Capture1.JPG


And, in the Test part, I changed the LB2.Selected(3) = True to LB2.Selected(3) = False. It looks like the whole macro still works. What's the reason.

Thanks a lot!

[mdmackillop]

You need to offset by columns rather than rows to read the data

Cells(12, 14).Offset(k) = dat.Offset(, i + 1)

And, in the Test part, I changed the LB2.Selected(3) = True to LB2.Selected(3) = False. It looks like the whole macro still works. What's the reason.

True sets Listbox2 to show Flag selected as default. Do not set to False; delete the line if not required

[463933645]

Hi mdmackillop, I understand. I should put a comma to offset by columns. Thanks.

There is a new problem with Listbox2 when I add two more columns before "flag" in sheet 'Data'. I changed the code below.

In Test part:

 LB2.List = Array("General Intro", "Population", "Population growth", "GDP", "Weather", "Flag") 'GDP and Weather are newly added columns

LB2.Selected(5) = True'I still want to show Flag selected as default.

In DoInfo part:

With ListBox2

    For i = 0 To 5 'it was i=0 to 3. I added 2 columns so I changed it to 5...

The Problem:
Capture12.JPG

What is the reason and how to fix it. Thanks

[463933645]

Hi mdmackillop, I replicate this model in a new case with more provinces and columns. The ListBox2 does not work well. There is something wrong. Could you help to explain the part which I did wrongly.

The other thing is what if the contents of province is long, e.g. a short paragraph.

I am also attaching the excel here. THANKS! !

Sub Test()    Dim LB1 As MSForms.ListBox
    Dim LB2 As MSForms.ListBox
    
    Set LB1 = ActiveSheet.ListBox1
    Set LB2 = ActiveSheet.ListBox2
    
    LB1.Clear: LB2.Clear
    
    For Each shp In ActiveSheet.Shapes.Range(Array("group 3")).GroupItems
        If Left(shp.Name, 4) <> "Free" Then
            LB1.AddItem (shp.Name)
        End If
    Next
    
    LB2.List = Array("Intro", "Manager", "Sales", "Budget", "Difference", "Pic")
    LB2.Selected(3) = True
    
End Sub

Private Sub ListBox1_Click()
    Application.ScreenUpdating = False
    Set r = Selection
    Reset
    DoColor ListBox1
    DoInfo ListBox1
    DoEvents
    r.Select
    Application.ScreenUpdating = True


End Sub


Private Sub ListBox2_Change()
    ListBox1_Click
End Sub


Sub DoInfo(State)
    Dim wsD As Worksheet
    If Not State = "" Then
    Set wsD = Sheets("data")
    Set Target = Range("P4")
    Target.Resize(8, 18).ClearContents
    For Each Shape In ActiveSheet.Shapes
        If Shape.TopLeftCell.Address = "$P$4" Then Shape.Delete
    Next
    With ListBox2
        For i = 0 To 5
            If .Selected(i) Then
                Select Case .List(i)
                Case "Pic"
                    wsD.Shapes("Pic" & State).Copy
                    ActiveSheet.Paste Target
                Case Else
                    Set dat = wsD.Columns(2).Cells.Find(State)
                    k = k + 1
                    Cells(16, 16).Offset(k) = .List(i)
                    Cells(16, 18).Offset(k) = dat.Offset(, i + 1)
                End Select
            End If
        Next i
    End With
    End If
    
End Sub


Sub DoColor(State)
    If Not State = "" Then
    With ActiveSheet.Shapes.Range(Array(State)).Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 176, 80)
        .Transparency = 0
        .Solid
    End With
    End If
End Sub


Sub Reset()
    With ActiveSheet.Shapes.Range(Array("Anhui", "Hebei", "Henan", "Heilongjiang", "Hubei", "Jilin", "Jiangsu", "Liaoning", "Shanxi", "Gansu", "Ningxia", "Sichuan", "Chongqing", "Xinjiang", "Fujian", "Guangdong", "Guangxi", "Hainan", "Jiangxi", "Yunnan", "Guizhou", "Zhejiang", "Hunan", "Shandong")).Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = -0.0500000007
        .Transparency = 0
        .Solid
    End With
End Sub

[mdmackillop]

Your map is missing some region names. Where can it be downloaded?

[mdmackillop]

Code revised

[463933645]

Hi mdmackillop, actually, I did not include all provinces because some of them are not important in this case. I just use your code to exclude those names-unchanged ones.

[463933645]

Thanks so much. I will check the code and see the changes right away.