Excel VBA functions

functions.bas

Function CONCATENATEMULTIPLE(Ref As Range, Optional Separator As String = "") As String
	' Combine multiple cells using a separator/delimiter.
    Dim Cell As Range
    Dim Result As String
    For Each Cell In Ref
        If Not IsEmpty(Cell) Then
            Result = Result & Cell.value & Separator
        End If
        Next Cell
        
    If Separator = "" Then
        CONCATENATEMULTIPLE = Left(Result, Len(Result))
    Else
        CONCATENATEMULTIPLE = Left(Result, Len(Result) - 1)
    End If
End Function


Sub AddCheckBoxes()
'
' Add Check Boxes to a range of cells linking boxes to cell's values
'
  Const BoxSize As Double = 17.25
  Dim xpos As Double
  Dim ypos As Double
  
  For Each cell In Application.Selection
    Line = cell.Row
    col = cell.Column
    
    xpos = Cells(Line, col).Left + ((cell.Width / 2) - (BoxSize / 2))
    ypos = Cells(Line, col).Top + ((cell.Height / 2) - (BoxSize / 2))
    
    ActiveSheet.CheckBoxes.Add(xpos, ypos, BoxSize, BoxSize).Select
    With Selection
        .LinkedCell = Cells(Line, col).Address
        .Caption = ""
        .Display3DShading = False
    End With
    Next cell
    
End Sub


Sub AddActivexCheckBoxes()
'
' Add ActiveX CheckBoxes to a range of cells linking boxes to cell's values. The boxes will resize\hidde with the cells.
'
  Const BoxSize As Double = 20
  Dim xpos As Double
  Dim ypos As Double
  
  For Each cell In Application.Selection
    Line = cell.Row
    col = cell.Column
    
    xpos = Cells(Line, col).Left + ((cell.Width / 2) - (BoxSize / 2))
    ypos = Cells(Line, col).Top + ((cell.Height / 2) - (BoxSize / 2))
    
    ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Left:=xpos, Top:=ypos, Width:=BoxSize, Height:=BoxSize).Select
        
    With Selection
        .LinkedCell = Cells(Line, col).Address
        .Object.Caption = ""
        .Placement = xlMoveAndSize
    End With
    Next cell
    
End Sub