Range("U" & j).Delete Shift:=xlShiftUp <--- Is not executing

[JayWes]

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

 

[Joel]

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

 

[Dave Peterson]

I didn't look at you code too closely, but when you're deleting (or inserting)
rows/cells, it really makes the code easier if you start at the bottom of the
range and work your way up.

dim iRow as long
dim FirstRow as long
dim LastRow as long

'just test data. You'll have to determine the top and bottom rows.
firstrow = 3
lastrow = 88

for irow = lastrow to firstrow step -1
'if the current row is equal to the previous row, delete the current row
If imds.range("T" & irow).value = imds.range("T" & irow - 1).value then
IMDS.Range("T" & irow).Delete Shift:=xlShiftUp
End If
next irow

If you wanted to delete the entire row, you could use this:
IMDS.rows(irow).Delete
instead of:
IMDS.Range("T" & irow).Delete Shift:=xlShiftUp

 

[JayWes]

Like I said in the original post, I've tried different methods... I used
almost that exact same code and still ran into the same problem yesterday.
I've tried do loops, for loops, working from the end to the beginning, etc,
and no matter what I've tried, the IMDS.Range("T" & irow).Delete
Shift:=xlShiftUp does not execute. When I run the debugger, the code goes to
that line, but it doesn't execute. If you look at my code, I use similar do
loops and cell delete statements throughout the workbook open sub routine at
the workbook scope level and they execute fine, but for some reason, when I
get inside of worksheet "IMDS's" scope (i.e. the comboboxes embeded in the
worksheet etc) the delete statements do not execute. Am I missing something?

 

[JayWes]

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?

 

[Charlie]

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.

 

[Dave Peterson]

I find that it's better to not use the rowsource/listfillrange. I'd add the
items to the combobox in code.