Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Range("U" & j).Delete Shift:=xlShiftUp <--- Is not executing
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Range("U" & j).Delete Shift:=xlShiftUp <--- Is not executing
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 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Range("U" & j).Delete Shift:=xlShiftUp <--- Is not executing
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 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 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 -- Dave Peterson |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Range("U" & j).Delete Shift:=xlShiftUp <--- Is not executing
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? "Dave Peterson" wrote: 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 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 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Range("U" & j).Delete Shift:=xlShiftUp <--- Is not executing
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 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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Range("U" & j).Delete Shift:=xlShiftUp <--- Is not executing
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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Range("U" & j).Delete Shift:=xlShiftUp <--- Is not executing
I find that it's better to not use the rowsource/listfillrange. I'd add the
items to the combobox in code. JayWes wrote: 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? "Dave Peterson" wrote: 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 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 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 -- Dave Peterson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Can I have "Shift-Click" or "Ctrl-Click" Code on Form List? | Excel Programming | |||
Run-time error "5" after range().delete runs before querytable.add | Excel Programming | |||
How 2 use right shift "<<" and left shift "" operator in excel? | Excel Programming | |||
use variable in Workbooks("book1").Worksheets("sheet1").Range("a1" | Excel Programming | |||
Insert 19 cells "Shift to the right" if cell contains "-" | Excel Programming |