Trying to minimise my code

[TonyUK72]

    ActiveSheet.Shapes("Q1A1").Select
    With Selection
        .Value = xlOff
        .LinkedCell = "Result_DataLISTS!$C$1"
        .Display3DShading = False
    End With
    ActiveSheet.Shapes("Q1A2").Select
    With Selection
        .Value = xlOff
        .LinkedCell = "Result_DataLISTS!$C$1"
        .Display3DShading = False
    End With
    ActiveSheet.Shapes("Q1A3").Select
    With Selection
        .Value = xlOff
        .LinkedCell = "Result_DataLISTS!$C$1"
        .Display3DShading = False
    End With
    ActiveSheet.Shapes("Q1A4").Select
    With Selection
        .Value = xlOff
        .LinkedCell = "Result_DataLISTS!$C$1"
        .Display3DShading = False
    End With

I have the above code, that essentially needs to be repeated 18 times. "Q1A1", "Q1A2", "Q1A3", "Q1A4" and $C$1 would become "Q2A1", "Q2A2", "Q2A3", "Q2A4" and $C$2 and so on.

Whilst I have used Dim, For and Next for ranges, using the same code for Active.Shapes seems to fail. Is this doable or do I need to have a bulk of code?

Thanks in advance.

 

[James006]

Hello,

Below is a macro to be tested ...

Sub Test()
Dim shp As Shape
Dim j As Long
  For Each shp In ActiveSheet.Shapes
    If Left(shp.Name, 1) = "Q" Then
        j = Mid(shp.Name, 2, 1)
        With shp
          .Value = xlOff
          .LinkedCell = "Result_DataLISTS!$C$" & j
          .Display3DShading = False
        End With
    End If
  Next shp
End Sub

Hope this will help

 

[TonyUK72]

Thank you, have tried this but it fails on line 6 with "Type Mismatch" error. Not sure how to manipulate your code for success.

- - - - - - - - -
So the Shapes I am trying to change are "Radio Buttons" named Q1A1 etc...... The worksheet also has "Group Boxes", if I hover over shp.Name in the code supplied the name of a "Group Box" appears instead of the "Radio Button".

Having not worked with "Controls" before I can see this might be a little more tricky than I thought.

 

[James006]

Re,

As far as the three lines which instruct to change parameters ... I just copied them from your own macro ... :wink:

What is exactly line 6 ...?

 

[TonyUK72]

Line 6 is

j = Mid(shp.Name, 2, 1)

if I hover over shp.Name it displays the name of a "Group Box" which is also on the worksheet.

 

[Yongle]

Try running LoopShapes from the sheet containing the shapes

Sub LoopShapes()
    Dim q As Integer, i As Integer, shp As String, cel As String
        For i = 1 To 18
            For q = 1 To 4
                shp = "Q" & i & "A" & q
                cel = "$c$" & i
                Call ShapeProperties(shp, cel)
            Next q
        Next i
End Sub

Sub ShapeProperties(ShapeName As String, LinkCell As String)
    ActiveSheet.Shapes(ShapeName).Select
    With Selection
        .Value = xlOff
        .LinkedCell = "Result_DataLISTS!" & LinkCell
        .Display3DShading = False
    End With
End Sub

 

[James006]

Hello,

Regarding your radio buttons ...

Are they Forms Option Buttons or ActiveX Option Buttons ?

 

[TonyUK72]

Forms ​not ActiveX

 

[TonyUK72]

Try running LoopShapes from the sheet containing the shapes

Sub LoopShapes()
    Dim q As Integer, i As Integer, shp As String, cel As String
        For i = 1 To 18
            For q = 1 To 4
                shp = "Q" & i & "A" & q
                cel = "$c$" & i
                Call ShapeProperties(shp, cel)
            Next q
        Next i
End Sub

Sub ShapeProperties(ShapeName As String, LinkCell As String)
    ActiveSheet.Shapes(ShapeName).Select
    With Selection
        .Value = xlOff
        .LinkedCell = "Result_DataLISTS!" & LinkCell
        .Display3DShading = False
    End With
End Sub

This sort of works, but it doesn't cycle through ALL "Radio Buttons".

The spreadsheet has 18 "Group Boxes" each "Group Box" is essentially a Multiple Choice Question, that has four answers, each possible answer is a "Radio Button". So your solution above clears the first 16 "Radio Buttons" from the first 4 "Group Boxes".

I am going to see if I can do anything with it.

 

[James006]

Re,

Below is a macro to be tested along with the Group Boxes ...

Sub OptionButtonLoop()
' Source : https://wellsr.com/vba/2016/excel/
' Loop through ALL Option Buttons
Dim rb As Shape
  For Each rb In ActiveSheet.Shapes
    If rb.Type = msoFormControl Then
      If rb.FormControlType = xlOptionButton Then
        If rb.ControlFormat.Value = 1 Then
          'Do something if checked...
        ElseIf rb.ControlFormat.Value = -4146 Then
          'Do something if not checked...
        End If
      End If
    End If
  Next rb
End Sub

HTH