Can you shorten these macros?

L

leonidas

Hi,

I have the following two macros in Excel. The only thing is they take a
lot of space and time to type, because below I have the first three
objects, but it will have to be 250 objects! So can somebody help me
rewrite these two macros so that they will be a lot shorter? Thanks in
advance!

Sub ChangeComboBoxProperties()

Dim ComboBox1 As OLEObject
Dim ComboBox2 As OLEObject
Dim ComboBox3 As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet

Set ComboBox1 = ws.OLEObjects("ComboBox1")
With ComboBox1
..LinkedCell = "'Rekenblad uitgangspunten WVB'!D3"
..ListFillRange = "'Rekenblad uitgangspunten WVB'!C3:C5"
End With

Set ComboBox2 = ws.OLEObjects("ComboBox2")
With ComboBox2
..LinkedCell = "'Rekenblad uitgangspunten WVB'!D6"
..ListFillRange = "'Rekenblad uitgangspunten WVB'!C6:C8"
End With

Set ComboBox3 = ws.OLEObjects("ComboBox3")
With ComboBox3
..LinkedCell = "'Rekenblad uitgangspunten WVB'!D9"
..ListFillRange = "'Rekenblad uitgangspunten WVB'!C9:C11"
End With

End Sub
--------------------------------------------------------------------
Sub ChangeFormula()

Sheets("Begroting WVB").Activate
Range("M12").FormulaR1C1 = "'Rekenblad uitgangspunten WVB'!F3"
Range("M13").FormulaR1C1 = "'Rekenblad uitgangspunten WVB'!F6"
Range("M14").FormulaR1C1 = "'Rekenblad uitgangspunten WVB'!F9"

End Sub
 
B

Bob Phillips

Direct way

Const SheetName As String = "'Rekenblad uitgangspunten WVB'!"

Sub ChangeComboBoxProperties()

Call LinkCombo(ws.OLEObjects("ComboBox1"), "D3", "C3:C5")
Call LinkCombo(ws.OLEObjects("ComboBox2"), "D6", "C6:C8")
Call LinkCombo(ws.OLEObjects("ComboBox3"), "D9", "C9:C11")
End Sub

Private Sub LinkCombo(pCombo As OLEObject, pLink As String, pList As String)

With pCombo
.LinkedCell = SheetName & pLink
.ListFillRange = SheetName & pList
End With

End Sub

Sub ChangeFormula()

Sheets("Begroting WVB").Activate
Call AddFormula(Range("M12"), "F3")
Call AddFormula(Range("M13"), "F6")
Call AddFormula(Range("M14"), "F9")

End Sub

Private Sub AddFormula(pRng As Range, pCell As String)
pRng.FormulaR1C1 = SheetName & pCell
End Sub


Less obvious, but less typing/copy-pasting for you, just change the upper
limit of the loop from 3 to your top end

Const SheetName As String = "Sheet3!" '"'Rekenblad uitgangspunten WVB'!"

Sub ChangeComboBoxProperties()
Dim ws As Worksheet
Dim i As Long

Set ws = ActiveSheet

For i = 1 To 3
Call LinkCombo(ws.OLEObjects("ComboBox" & i), "D" & i * 3, "C" & i *
3 & ":C" & i * 3 + 2)
Next i
End Sub

Private Sub LinkCombo(pCombo As OLEObject, pLink As String, pList As String)

With pCombo
.LinkedCell = SheetName & pLink
.ListFillRange = SheetName & pList
End With

End Sub

Sub ChangeFormula()
Dim i As Long

Sheets("Begroting WVB").Activate
For i = 1 To 3
Call AddFormula(Range("M" & i + 11), "F" & i * 3)
Next i

End Sub

Private Sub AddFormula(pRng As Range, pCell As String)
pRng.FormulaR1C1 = SheetName & pCell
End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
R

raypayette

I used the Forms Toolbox to add a single combo box ("Drop Down 2"), then
I automated everything with:

Sub MakeCombo()
Dim m, n, i As Integer
n = 3
m = 12
For i = 0 To 250
ActiveSheet.Shapes("Drop Down 2").Select
With Selection
..ListFillRange = "$D$" & (n + (3 * i)) & ":$D$" & ((n + 2)
+ (3 * i))
..LinkedCell = "$C$" & (n + (3 * i))
End With
Sheets("Begroting WVB").Select
Range("M" & (m + (i * 3))).Select
ActiveCell.FormulaR1C1 = "='Rekenblad uitgangspunten
WVB'!R[-9]C[-10]"
Sheets("Rekenblad uitgangspunten WVB").Select
ActiveSheet.Shapes("Drop Down 2").Select
Selection.Copy
Cells(n + (i * 3), 6).Select
ActiveSheet.DropDowns.Add(287.25, 75.75, 143.25, 15.75).Select
ActiveSheet.Paste
Next
End Sub
 
L

leonidas

Hi Bob,

I have problems with both shortened macros.
The one below gives an outcome 'Rekenblad uitgangspunten WVB'!F3 with
the "=" sign. When I add this to the macro the outcome is ='Rekenblad
uitgangspunten WVB'!'F3' with those quotation marks around F3 and then
the formula doesn't work. Do you have a solution for this?

Sub ChangeFormula()

Dim i As Long

Sheets("Begroting Calc (2)").Activate
For i = 1 To 10
Call AddFormula(Range("M" & i + 11), "F" & i * 3)
Next i

End Sub

Private Sub AddFormula(pRng As Range, pCell As String)

Const SheetName As String = "'Rekenblad uitgangspunten WVB'!"
pRng.FormulaR1C1 = SheetName & pCell

End Sub

The other macro, below, gives an error and marks the yellow line (by
the way: I have changed the split line to 1 line, so that's not the
problem):
Run-time error '1004':
Method 'OLEObjects' of '_Worksheet' failed
Do you have a solution for this problem too?

Sub ChangeComboBoxProperties()

Dim ws As Worksheet
Dim i As Long

Set ws = ActiveSheet

For i = 1 To 10
Call LinkCombo(ws.OLEObjects("ComboBox" & i), "D" & i * 3, "C" & i * 3
& ":C" & i * 3 + 2)
Next i

End Sub

Private Sub LinkCombo(pCombo As OLEObject, pLink As String, pList As
String)

Const SheetName As String = "'Rekenblad uitgangspunten WVB'!"
With pCombo
..LinkedCell = SheetName & pLink
..ListFillRange = SheetName & pList
End With

End Sub

Thanks in advance!
 
B

Bob Phillips

On the first one, part of the problem was mine (I omitted the =), part was
yours (using FormulaR1C1) <G>.

This works

Sub ChangeFormula()

Dim i As Long

Sheets("Begroting Calc (2)").Activate
For i = 1 To 10
Call AddFormula(Range("M" & i + 11), "F" & i * 3)
Next i

End Sub

Private Sub AddFormula(pRng As Range, pCell As String)

Const SheetName As String = "'Rekenblad uitgangspunten WVB'!"
pRng.Formula = "=" & SheetName & pCell

End Sub


This code works fine for me

Sub ChangeComboBoxProperties()
Dim ws As Worksheet
Dim i As Long

Set ws = ActiveSheet

For i = 1 To 10
Call LinkCombo(ws.OLEObjects("ComboBox" & i), _
"D" & i * 3, "C" & i * 3 & ":C" & i * 3 + 2)
Next i

End Sub

Private Sub LinkCombo(pCombo As OLEObject, _
pLink As String, _
pList As String)

Const SheetName As String = "'Rekenblad uitgangspunten WVB'!"
With pCombo
..LinkedCell = SheetName & pLink
..ListFillRange = SheetName & pList
End With
End Sub

BTW, I can't see the yellow line, I am on the NGs, not on ExcelForum.


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
L

leonidas

Hi Bob,

Thanks! Both macros work fine now!
The problem with the run-time error was mine. I have a non-continuou
range of comboboxes, so if the number goes from 15 to 17 an erro
occurs. By adding "On Error Resume Next" this problem is solved.
Thanks again for your help
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Change properties of a combobox with VBA 0
Data Validation - Combo Box open with single click 0
Run time Error - Application Defined or Object Defined Error Excel Vba 0
Error with OLEObjects 2
Combobox Code, Wont Copy and paste? 3
Combo box with Data Validation feature 2
Combo box macro problems 8
List Box Linked Cell loses connection 1

Top