I wrote some code to populate 6 Control Toolbox Comboboxes when my workbook
is opened. To do this, my code inserts the values from a master column into
destination column. Duplicate data is then deleted from the destination
column... Finally the destination data is used to populate one of the
comboboxes... This is repeated for each of the other comboboxes. This
portion of my code works fine.

Later, based on the selection made in one of the comboboxes, I want to
update the lists of the other comboboxes. I try to use a similar method to
re-populate the the other comboboxes, but a line near the end of my code
(which I have identified) is not executing. This is the line:

IMDS.Range("U" & i).Delete Shift:=xlShiftUp

I can not figure out why this line will not execute... I have tried other
methods of deleting the cells which contain duplicate data, but I cannot get
the code to "delete" a cell.

Any suggestions as to why this is would be much appreciated.

Thanks in advance,
Jason


'******** Takes Place When Workbook Opens***********
Private Sub Workbook_Open()
Dim IMDS As Worksheet
Set IMDS = Workbooks("IMDS Calc.xls").Worksheets("IMDS")

Dim CB1 As OLEObject
Dim CB2 As OLEObject
Dim CB3 As OLEObject
Dim CB4 As OLEObject
Dim CB5 As OLEObject
Dim CB6 As OLEObject
Set CB1 = IMDS.OLEObjects("ComboBox1")
Set CB2 = IMDS.OLEObjects("ComboBox2")
Set CB3 = IMDS.OLEObjects("ComboBox3")
Set CB4 = IMDS.OLEObjects("ComboBox4")
Set CB5 = IMDS.OLEObjects("ComboBox5")
Set CB6 = IMDS.OLEObjects("ComboBox6")

Dim Counti As Integer
Dim i As Integer
Dim j As Integer



Application.ScreenUpdating = False

'Determine Issuers
Counti = 2
Do
Issuer = IMDS.Range("AA" & Counti).Value
Counti = Counti + 1
IMDS.Range("T" & Counti).Value = Issuer
If IMDS.Range("AA" & Counti).Value = "" Then Exit Do
Loop

Counti = Counti - 1
i = 2

Do
Issuer = IMDS.Range("AF" & i).Value
i = i + 1
Counti = Counti + 1
IMDS.Range("T" & Counti).Value = Issuer
If IMDS.Range("AF" & i).Value = "" Then Exit Do
Loop


' Filter Out Duplicate Issuer Entries
i = 2
Do
i = i + 1
If IMDS.Range("T" & i).Value = "" Then Exit Do
Issuer = IMDS.Range("T" & i).Value
j = i
Do
j = j + 1
If IMDS.Range("T" & j).Value = "" Then Exit Do
IssuerC = IMDS.Range("T" & j).Value
If Issuer = IssuerC Then
IMDS.Range("T" & j).Delete Shift:=xlShiftUp
j = j - 1
End If
Loop
Loop

Counti = i - 1

Application.ScreenUpdating = True


' Fill Spec Issuer ComboBox
Dim RIssuer As Range
Set RIssuer = IMDS.Range("T2:T" & Counti)
CB1.ListFillRange = RIssuer.Address

Application.ScreenUpdating = False







'Determine Coatings
i = 1
Counti = 2
Do
i = i + 1
If IMDS.Range("AC" & i).Value = "" Then Exit Do
Coating = IMDS.Range("AC" & i).Value
Counti = Counti + 1
IMDS.Range("U" & Counti).Value = Coating
Loop

' Filter Out Duplicate Coating Entries
i = 2
Do
i = i + 1
If IMDS.Range("U" & i).Value = "" Then Exit Do
Coating = IMDS.Range("U" & i).Value
j = i
Do
j = j + 1
If IMDS.Range("U" & j).Value = "" Then Exit Do
CoatingC = IMDS.Range("U" & j).Value
If Coating = CoatingC Then
IMDS.Range("U" & j).Delete Shift:=xlShiftUp
j = j - 1
End If
Loop
Loop

Counti = i - 1

Application.ScreenUpdating = True


' Fill Coating Type ComboBox
Dim RCoating As Range
Set RCoating = IMDS.Range("U2:U" & Counti)
CB2.ListFillRange = RCoating.Address





Application.ScreenUpdating = False

'Determine Coating Specs
i = 1
Counti = 2
Do
i = i + 1
If IMDS.Range("AB" & i).Value = "" Then Exit Do
CSpec = IMDS.Range("AB" & i).Value
Counti = Counti + 1
IMDS.Range("V" & Counti).Value = CSpec
Loop

' Filter Out Duplicate Coating Spec Entries
i = 2
Do
i = i + 1
If IMDS.Range("V" & i).Value = "" Then Exit Do
CSpec = IMDS.Range("V" & i).Value
j = i
Do
j = j + 1
If IMDS.Range("V" & j).Value = "" Then Exit Do
CSpecC = IMDS.Range("V" & j).Value
If CSpec = CSpecC Then
IMDS.Range("V" & j).Delete Shift:=xlShiftUp
j = j - 1
End If
Loop
Loop

Counti = i - 1

Application.ScreenUpdating = True


' Fill Coating Spec ComboBox
Dim RCSpec As Range
Set RCSpec = IMDS.Range("V2:V" & Counti)
CB3.ListFillRange = RCSpec.Address






Application.ScreenUpdating = False

'Determine Substrate
i = 1
Counti = 2
Do
i = i + 1
If IMDS.Range("AH" & i).Value = "" Then Exit Do
Substrate = IMDS.Range("AH" & i).Value
Counti = Counti + 1
IMDS.Range("W" & Counti).Value = Substrate
Loop

' Filter Out Duplicate Substrate Entries
i = 2
Do
i = i + 1
If IMDS.Range("W" & i).Value = "" Then Exit Do
Substrate = IMDS.Range("W" & i).Value
j = i
Do
j = j + 1
If IMDS.Range("W" & j).Value = "" Then Exit Do
SubstrateC = IMDS.Range("W" & j).Value
If Substrate = SubstrateC Then
IMDS.Range("W" & j).Delete Shift:=xlShiftUp
j = j - 1
End If
Loop
Loop

Counti = i - 1

Application.ScreenUpdating = True


' Fill Substrate ComboBox
Dim RSubstrate As Range
Set RSubstrate = IMDS.Range("W2:W" & Counti)
CB4.ListFillRange = RSubstrate.Address






Application.ScreenUpdating = False

'Determine Substrate Specs
i = 1
Counti = 2
Do
i = i + 1
If IMDS.Range("AG" & i).Value = "" Then Exit Do
SSpec = IMDS.Range("AG" & i).Value
Counti = Counti + 1
IMDS.Range("X" & Counti).Value = SSpec
Loop

' Filter Out Duplicate Substrate Spec Entries
i = 2
Do
i = i + 1
If IMDS.Range("X" & i).Value = "" Then Exit Do
SSpec = IMDS.Range("X" & i).Value
j = i
Do
j = j + 1
If IMDS.Range("X" & j).Value = "" Then Exit Do
SSpecC = IMDS.Range("X" & j).Value
If SSpec = SSpecC Then
IMDS.Range("X" & j).Delete Shift:=xlShiftUp
j = j - 1
End If
Loop
Loop

Counti = i - 1

Application.ScreenUpdating = True


' Fill Substrate Spec ComboBox
Dim RSSpec As Range
Set RSSpec = IMDS.Range("X2:X" & Counti)
CB5.ListFillRange = RSSpec.Address


' Fill Units ComboBox
Dim RUnits As Range
Set RUnits = IMDS.Range("Y2:Y4")
CB6.ListFillRange = RUnits.Address


IMDS.Range("F6").Value = "<Enter"
IMDS.Range("F9").Value = "<Enter"
IMDS.Range("F11").Value = "<Enter"
End Sub


'**Updating Other ComboBox Lists When ComboBox1 Selection Is Changed**

Private Sub ComboBox1_Change()
Dim IMDS As Worksheet
Set IMDS = Workbooks("IMDS Calc.xls").Worksheets("IMDS")

Dim CB1 As OLEObject
Dim CB2 As OLEObject
Dim CB3 As OLEObject
Dim CB4 As OLEObject
Dim CB5 As OLEObject
Dim CB6 As OLEObject
Set CB1 = IMDS.OLEObjects("ComboBox1")
Set CB2 = IMDS.OLEObjects("ComboBox2")
Set CB3 = IMDS.OLEObjects("ComboBox3")
Set CB4 = IMDS.OLEObjects("ComboBox4")
Set CB5 = IMDS.OLEObjects("ComboBox5")
Set CB6 = IMDS.OLEObjects("ComboBox6")

Dim Counti As Integer
Dim i As Integer
Dim j As Integer

CB1V = ComboBox1.Value
If CB1V = "<Select" Then Exit Sub

Application.ScreenUpdating = False

Dim RCoating As Range
Set RCoating = IMDS.Range("U2")
CB2.ListFillRange = RCoating.Address

Dim RCSpec As Range
Set RCSpec = IMDS.Range("V2")
CB3.ListFillRange = RCSpec.Address

Dim RSubstrate As Range
Set RSubstrate = IMDS.Range("W2")
CB4.ListFillRange = RSubstrate.Address

' Fill Substrate Spec ComboBox
Dim RSSpec As Range
Set RSSpec = IMDS.Range("X2")
CB5.ListFillRange = RSSpec.Address


'Clearing ComboBoxes
j = 20
Do
j = j + 1
If j = 25 Then Exit Do
i = 2
Do
i = i + 1
If IMDS.Cells(i, j).Value = "" Then Exit Do
On Error Resume Next
IMDS.Cells(i, j).ClearContents
Loop
Loop



'Determine Coatings
i = 1
Counti = 2
Do
i = i + 1
If IMDS.Range("AA" & i).Value = "" Then Exit Do
Issuer = IMDS.Range("AA" & i)
If Issuer = CB1V Then
Coating = IMDS.Range("AC" & i).Value
Counti = Counti + 1
IMDS.Range("U" & Counti).Value = Coating
End If
Loop

' Filter Out Duplicate Coating Entries
i = 2
Do
i = i + 1
If IMDS.Range("U" & i).Value = "" Then Exit Do
Coating = IMDS.Range("U" & i).Value
j = i
Do
j = j + 1
If IMDS.Range("U" & j).Value = "" Then Exit Do
CoatingC = IMDS.Range("U" & j).Value
If Coating = CoatingC Then

'****The following line is not executing for some reason******
IMDS.Range("U" & j).Delete Shift:=xlShiftUp
j = j - 1
End If
Loop
Loop

Counti = i - 1
Application.ScreenUpdating = True


' Fill Coating Type ComboBox
Set RCoating = IMDS.Range("U2:U" & Counti)
CB2.ListFillRange = RCoating.Address
End Sub