Two suggestions:

1) If the control has focus (has just been clicked) do ActiveCell.Activate
to get the focus back to the sheet.

2) Sometimes your code needs to be put in a standard module if you are
modifying a different sheet.


"JayWes" wrote:

Joel,

That is a better way to treat j; however, j's value is not the problem.
When I run the debugger, the code goes to the .Delete line, j's value is
correct, everything seems to be working fine, but the line just doesn't
perform the operation of deleting the cell. The same exact do loop
executes fine in the workbook's scope when I open the workbook, but at the
worksheet level (where the comboboxes are embedded) any line that has .Delete
Shift:=@@@ does not execute. The code runs through like the operation is
being performed, but the cells do not get deleted from the worksheet. Any
ideas?

"Joel" wrote:

try this change. I think the problem has something to do with the statement
j = j - 1. I changed the way j ws being incremented. I set j = i + 1 (used
to be j = i).

Do
i = i + 1
If IMDS.Range("U" & i).Value = "" Then Exit Do
Coating = IMDS.Range("U" & i).Value
j = i + 1
Do
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
else
j = j + 1
End If
Loop
Loop



"JayWes" wrote:

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