Máximos colaboradores

Hola, Pues el código que ha compartido (en mi opinión) se ve bien en su estructura, tal vez el problema de que se borre el ítem se deba a la forma en que se está limpiando el ComboBox. Por qué no guarda el ítem seleccionando una variable selectedItem. Así después de limpiar y volver a llenar el ComboBox, restaura el ítem seleccionado. Algo así: Private Sub Combobox1_DropButtonClick() Dim sd As New Collection Dim celda As Range Dim dato Dim r As Range Dim UF As Integer Dim selectedItem As String On Error Resume Next Worksheets("CONSOLIDADO").Activate Range("S2").Select ' Guarda el ítem seleccionado selectedItem = Combobox1.Value ' Limpia el ComboBox Combobox1.Clear With Worksheets("BASE") UF = .Range("S" & Rows.Count).End(xlUp).Row Set r = .Range("S2:S" & UF) For Each celda In r sd.Add celda.Value, CStr(celda.Value) Next celda For Each dato In sd Combobox1.AddItem dato Next dato End With ' Restaura el ítem seleccionado Combobox1.Value = selectedItem End Sub

Prueba esta macro, vale para cualquier cantidad de filas/columnas. Const Naranja As Long = 6403322 Const Morado As Long = 11423218 Const Verde As Long = 4896057 Const Rojo As Long = 6709491 '-- Sub Resaltes() Dim Sales As Range, Fcst As Range Application.ScreenUpdating = False '-- For x = 2 To Range("A" & Rows.Count).End(xlUp).Row Step 2 For y = 4 To Cells(1, Columns.Count).End(xlToLeft).Column '-- Set Fcst = Cells(x, y) Set Sales = Cells(x, y).Offset(1) '-- Sales.Interior.ColorIndex = xlNone Fcst.Interior.ColorIndex = xlNone '-- If Sales <> "" Then If Round(Sales) = 0 And Round(Fcst) > 0 Then Sales.Interior.Color = Rojo Fcst.Interior.Color = Rojo End If '-- If Round(Sales) <> 0 And Round(Sales) < Round(Fcst) Then Sales.Interior.Color = Naranja Fcst.Interior.Color = Naranja End If '-- If Round(Sales) = Round(Fcst) Then Sales.Interior.Color = Verde Fcst.Interior.Color = Verde End If '-- If Round(Sales) <> 0 And Round(Fcst) < Round(Sales) Then Sales.Interior.Color = Morado Fcst.Interior.Color = Morado End If '-- End If Next Next End Sub