Option button linked cells

Sorry, I forgot all about the groups. My fault for not testing properly. Try the following with the changes in Red.

Lewis

Sub InsertRowsAndFillFormulas()

   Dim iCurrentRow As Long
   Dim iRowOffset As Long
   Dim iRow As Long
   Dim sCell As String
   Dim sGroupName As String
   Dim x As Long
   ActiveCell.EntireRow.Select
   If vrows = 0 Then
    vrows = Application.InputBox(prompt:= _
      "How many rows do you want to add?", Title:="Add Rows", _
      Default:=1, Type:=1)
    If vrows = False Then Exit Sub
    
    'Add test for vrows > 0 and < some aribitrary max limit
    
   End If
   Dim sht As Worksheet, shts() As String, i As Long
   ReDim shts(1 To Worksheets.Application.ActiveWorkbook. _
       Windows(1).SelectedSheets.Count)
   i = 0
   For Each sht In _
       Application.ActiveWorkbook.Windows(1).SelectedSheets
    Sheets(sht.Name).Select
    i = i + 1
    shts(i) = sht.Name

    x = Sheets(sht.Name).UsedRange.Rows.Count
    
    Selection.Resize(rowsize:=2).Rows(2).EntireRow. _
     Resize(rowsize:=vrows).Insert Shift:=xlDown

    Selection.AutoFill Selection.Resize( _
     rowsize:=vrows + 1), xlFillDefault
     
    'Get the current row
    iRow = ActiveCell.Row
    
    'Put OptionButtons in column F of the following rows
    For iRowOffset = 1 To vrows
      iCurrentRow = iRow + iRowOffset
      sCell = "F" & iCurrentRow
      
      'Create a UNIQUE Group Name for the Option Buttons Based on
      'the Current Date and Time of the form ("Groupyymmddhhmmss-NNNN")
      'Where NNNN is the current row number
      sGroupName = "Group" & Format(Now(), "yymmddhhmmss") & "-" & Format(iCurrentRow, "0000")
    
      Call PutOptionButtonsInCell(sCell, sGroupName)
    Next iRowOffset
    
    On Error Resume Next
    Next
    
End Sub


Sub PutOptionButtonsInCell(sAddress As String, sGroupName As String)

    Const xHorizontalOFFSET = 6

    Dim r As Range
    Dim wbo As Workbook
    Dim wbs As Worksheet
    Dim btn As Object
    
    Dim iRow As Long
    
    Dim xLeft As Double
    Dim xTop As Double
    Dim xWidth As Double
    Dim xHeight As Double
        
    Dim xCellLeft As Double
    Dim xCellTop As Double
    Dim xCellWidth As Double
    Dim xCellHeight As Double
    
    Set r = ActiveSheet.Range(sAddress)
    iRow = r.Row
    
    xCellLeft = r.Left
    xCellTop = r.Top
    xCellWidth = r.Width
    xCellHeight = r.Height
    

    Set wbo = ActiveWorkbook
    Set wbs = wbo.ActiveSheet
 
    With ActiveSheet
    
        xLeft = xCellLeft + xHorizontalOFFSET
        xWidth = xCellWidth - xHorizontalOFFSET
        xHeight = xCellHeight / 4
        xTop = xCellTop + xHeight / 2
        Set btn = .OLEObjects.Add(ClassType:="Forms.OptionButton.1", _
                                  Link:=True, _
                                  DisplayAsIcon:=False, _
                                  Left:=xLeft, _
                                  Top:=xTop, _
                                  Width:=xWidth, _
                                  Height:=xHeight)
        btn.Object.Caption = "Credit Card"
        btn.Object.GroupName = sGroupName
        btn.LinkedCell = "J" & iRow
        btn.Object.Value = False
        btn.Object.GroupName = sGroupName
                    
                    
        xTop = xTop + xHeight
        Set btn = .OLEObjects.Add(ClassType:="Forms.OptionButton.1", _
                                  Link:=True, _
                                  DisplayAsIcon:=False, _
                                  Left:=xLeft, _
                                  Top:=xTop, _
                                  Width:=xWidth, _
                                  Height:=xHeight)
        btn.Object.Caption = "Petty Cash"
        btn.Object.GroupName = sGroupName
        btn.LinkedCell = "K" & iRow
        btn.Object.Value = False
    
        xTop = xTop + xHeight
        Set btn = .OLEObjects.Add(ClassType:="Forms.OptionButton.1", _
                                  Link:=True, _
                                  DisplayAsIcon:=False, _
                                  Left:=xLeft, _
                                  Top:=xTop, _
                                  Width:=xWidth, _
                                  Height:=xHeight)
        btn.Object.Caption = "Purchase Order"
        btn.Object.GroupName = sGroupName
        btn.LinkedCell = "L" & iRow
        btn.Object.Value = False
    End With
End Sub