Writing Macro/VBA

[wheath]

I have never written a VBA or Macro in Excel. Now I need to and it is a complex one involving hundreds of checkboxes. Anyone will to help?

 

[excelginge]

Hi,

Can you explain what the problem is:-

Excelginge

 

[wheath]

Hi,

Can you explain what the problem is:-

Excelginge

I have about 1,000 checkboxes in one sheet in my workbook that I need to Format Control. I want them to Format Control to their cell, this is because I have some Conditional Formatting formulas in based on them being True when Checked. I don't know how to write a VBA or Macro that would accomplish this without messing up some of the others Formal Control I have on other checkboxes in that same sheet. All the other check boxes I did the Formal Control individually, but doing 1,000 individually seems kinds nuts if there is an easier way to do it.

It would be easier if I could attach the spreadsheet and you could see what I mean.

 

[excelginge]

Hi Again,

I believe you can send me a private message that includes your email address then once I have it i could email mine address then we can exchange spreadsheets.

Excelginge

 

[wheath]

Am still in need of assistance. I need to write a VBA that links the checkboxes in certain cells back to the cell they are in, without disrupting any of the other checkboxes or formatting I already have.

 

[wheath]

Someone suggested I explain what I need this way to see if it helps:

"You have a lot of check boxes and you want to use VBA to enter the cell address of where each one's output is stored on the spreadsheet?"

Hope this helps.

 

[excelginge]

Hi wheath,

In response to your inquiry I believe the following VBA code can be adapted to your needs.

Please also note that I've added a worksheet (Shape Location) this is to help you see what information the VBA has found (Before Update).
Also note after macro has run this only shows information prior to the cell being updated if linked to Check Box. If you run again it will show the new linked file.

Sub ShapesPostion()
Dim sShape As Shape
Dim ShpRow As Long
Dim ShpCol As Long
Dim lngRowWrite As Long
Dim wsS As Worksheet
Dim wsT As Worksheet
Dim lngMaxRow As Long
Dim wsSShape As Shape

'New Worksheets("Shape Location") headings
'Column A Shape Name
'Column B Column No
'Column C Column Letter
'Column D Row No
'Column E Cell Address
'Column F Check box Value 1 True (Ticked) -4146 = False (Unticked)
'Column G Linked Cell If not linked empty info From Check Box


lngRowWrite = 2
Set wsT = ThisWorkbook.Worksheets("Shape Location")
Set wsS = ThisWorkbook.Worksheets("Checklist")


lngMaxRow = wsT.Range("B1048576").End(xlUp).Row 'max row of wst


wsT.Rows("2:" & lngMaxRow).Delete
On Error Resume Next


For Each sShape In wsS.Shapes 'loop through each shape on worksheet
ShpRow = sShape.TopLeftCell.Row
ShpCol = sShape.TopLeftCell.Column

Set wsSShape = wsS.Shapes(sShape.Name) 'set referance to shape (Combo Box)

wsT.Range("A" & lngRowWrite).Offset(0, 0).Value = sShape.Name
wsT.Range("A" & lngRowWrite).Offset(0, 1).Value = sShape.TopLeftCell.Column
wsT.Range("A" & lngRowWrite).Offset(0, 2).Value = Split(wsT.Cells(ShpRow, ShpCol).Address(ColumnAbsolute:=False), "$")(0)
wsT.Range("A" & lngRowWrite).Offset(0, 3).Value = sShape.TopLeftCell.Row
wsT.Range("A" & lngRowWrite).Offset(0, 4).Value = wsT.Cells(ShpRow, ShpCol).Address

wsT.Range("A" & lngRowWrite).Offset(0, 5).Value = wsSShape.ControlFormat.Value
wsT.Range("A" & lngRowWrite).Offset(0, 6).Value = wsSShape.ControlFormat.LinkedCell


'It is up to you what you do here to only just update the ones you want


'ignore any Shape that is already linked

If Len(wsSShape.ControlFormat.LinkedCell) = 0 Then


'only allow rows 14-114
If sShape.TopLeftCell.Row >= 14 And sShape.TopLeftCell.Row <= 114 Then

'just do the columns you want
Select Case Split(wsT.Cells(ShpRow, ShpCol).Address(ColumnAbsolute:=False), "$")(0)
Case "AG", "AH", "AK", "AL", "AO", "AP", "AS", "AT", "AW", "AX", "BA", "BB", "BE", "BF", "BI", "BJ", "BM", "BN", "BQ", "BR"
wsSShape.ControlFormat.LinkedCell = wsT.Cells(ShpRow, ShpCol).Address
End Select
End If
End If
lngRowWrite = lngRowWrite + 1
Next 'get next shape

Set wsS = Nothing
Set wsT = Nothing

End Sub