VBA Macro Help Needed - Filling in a template

[Yourself93]

Hi everyone, looking for some help with a problem I am trying to solve. Before I get to it, I will preface this by saying that before yesterday I had never once touched VBA (to be honest didn't even know you could do anything close to this in excel) so if you go beyond even the basic of basics for explanations I probably won't understand. I have also historically hated coding and anything like that so yeah.

Anyway, I have been assigned a task at work to take a template that consists of 14 different possible rows where we want to copy and paste that info from a template worksheet into a designated location in a separate worksheet for that file. The thing that is causing problems for myself is that there are option buttons within what we are copying from the one worksheet to the other (I believe they are form control option buttons not active x). I have been able to copy over most things, but in one cell there will be 3 option buttons and for some reason I lose how they are grouped when they get copied over. The top option button works fine but the next two do not show properly (they appear to ungroup from the first option button). I am looking for help on how to get these option buttons to all copy over properly. After that I also need to be able to properly link the option buttons to a cell. Currently they are linked in the template file. Ex. if cell E3 has 3 option buttons these are linked to bell G3. If cell G3 is 1, then option button 1 in E3 is checkmarked, 2 for option button 2 etc. When I copy over the option buttons these buttons remain linked to cell G3 in the template file. I will need them to link to cell G3 of the new sheet I copy them to.

This is a lot of text and I am not sure if I worded it all correctly so please feel free to ask questions.

Code I currently have below is likely a mess (remember I have almost no knowledge of this), also it takes the above row as a reference point and copies what is in cell A and cell B from the above row to the new row created.

Sub Test()
'
Dim y As Long, btn As OLEObject, x As Long
y = ActiveCell.Row
' Test Macro
'

'
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Rows("1:1").EntireRow.Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
For Each btn In ActiveSheet.OLEObjects
If TypeName(btn.Object) = "CheckBox" And Not Intersect(btn.TopLeftCell, Sheets("Temp").Range("F2:BA2")) Is Nothing Then
x = btn.TopLeftCell.Column
btn.Copy
Cells(y, x).Select
ActiveSheet.Paste
End If
Next btn
Sheets("Temp").Range("F2:BA2").Copy Destination:=Sheets("year1").Cells(y, 6)
Application.ScreenUpdating = True
ActiveCell.Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
ActiveCell.Offset(0, 4).Range("A1:X1").Select
End Sub

I was told this was an easy task, so not feeling great that I cannot understand this.

 

[pbornemeier]

Sub RefreshFormControlButtonLink()

    Dim shp As Shape
    
    Worksheets("NewSheet").Activate
    For Each shp In ActiveSheet.Shapes
        If TypeName(shp.OLEFormat.Object) = "OptionButton" Then
            With shp.OLEFormat.Object
                .Value = xlOff
                .LinkedCell = "$G$3"
                .Display3DShading = False
            End With
        End If
    Next
    
End Sub

 

[Yourself93]

Alright, realize I have two threads on this but this one has a reply that partially works so I figured makes more sense to keep this one going. Tried editing/deleting the other thread but could not.

Anyway, for the above code (thanks btw) it somewhat does what I want. However it links every cell with an option button in the worksheet to G3. Is there any way to make this only effect the active cell?

For Each shp In ActiveSheet.Shapes --> I tried chaning this to ActiveCell.Shapes and it does not work so not sure how this would work.

Also, I would need .LinkedCell = "$G$3" to somehow instead link to the cell that is 25 columns to the right of the current selection. Ex. If the current cell with option buttons in it that need to be linked are in cell G10 then cell AG10 is the cell that needs to be linked to it.

I would also prefer this to happen to all cells in a row with option buttons as this code would need to be run 12 times if 12 different cells had option buttons in the cells. Not sure the people who want this macro would like that at all but one step at a time.

 

[pbornemeier]

Let me know if this is OK.
This will update the link for all Form Control Option buttons with their upper left corner in a selected cell. Multiple areas can be selected (by holding down control key)
The link will be 26 columns to the right (OB ULC in G10 wil reference AG10)

Option Explicit

Sub RefreshFormControlOptionButtonLinkInSelectedCells()
    'This will update the link for all Form Control Option buttons with their upper left corner in a selected cell
    'The link will be 26 columns to the right (OB ULC in G10 wil reference AG10)
    
    Dim shp As Shape
    Dim rngArea As Range
    Dim rngOBCell As Range
    
    For Each rngArea In Selection.Areas
        For Each shp In ActiveSheet.Shapes
            If Not Intersect(rngArea, shp.TopLeftCell) Is Nothing Then
                If TypeName(shp.OLEFormat.Object) = "OptionButton" Then
                    With shp.OLEFormat.Object
                        Set rngOBCell = shp.TopLeftCell
                        .Value = xlOff
                        .LinkedCell = rngOBCell.Offset(0, 26).Address
                        .Display3DShading = False
                    End With
                End If
            End If
        Next
    Next
    Set rngOBCell = Nothing
End Sub