Do you mean that the cell to check needs to change for each listbox?

B5, then B6, then B7, ..., B76???

If yes:

Option Explicit
Sub testme()

Dim OLEObj As OLEObject
Dim iCtr As Long
Dim CellToCheck As Range

Set CellToCheck = Sheet1.Range("b5")

For iCtr = 1 To 72
Set OLEObj = Sheet1.OLEObjects("Listbox" & iCtr)
With OLEObj.Object
.Clear
.AddItem "Select From List"
.AddItem "1 (High Risk)"
.AddItem "2"
.AddItem "3"
.AddItem "4"
.AddItem "5 (Low Risk)"

Select Case LCase(CellToCheck.Value)
Case Is = LCase("Select from List")
.ListIndex = 0
Case Is = LCase("1 (High Risk)")
.ListIndex = 1
Case Is = "2", "3", "4"
.ListIndex = CellToCheck.Value
Case Is = LCase("5 (Low Risk)")
.ListIndex = 5
End Select
End With
'dropdown one row for the next listbox
Set CellToCheck = CellToCheck.Offset(1, 0)
Next iCtr
End Sub


wrote:

Dave:

Thanks. Good question: No, I need the listindex to increment as well;
starting with B5. I guess that will change the code ...

Regards,

Jeff

--

Dave Peterson