Seleccionar Rango desde celda activa a siguiente celda con color con VBA
Quisiera una mano amiga para el siguiente problema. Tengo una tabla similar a la siguiente:
*Todos los datos de la tabla son variables. Puede haber tantos productos como componentes.
Quisiera que a partir de un textbox (utilizado para asignar Productos) busque en el rango A2 hasta el último dato; se coloque en esa celda y seleccione el rango desde la celda activa hasta la próxima celda con color -1. Por ejemplo: Si el textbox es: Producto 1. Entonces el código haría lo siguiente:
Si en el textbox se asigna: Producto 2. Entonces el código haría lo siguiente:
Pero además si en el textbox se asigna: Producto 3 o el producto que sea final, el código haría lo siguiente:
Aquí coloco un poco de código hasta donde he podido llegar, que no ha sido gran cosa, porque realmente no sé como hacerlo.
Dim myRange As Range
fila = 2
Sheets("BOM").Select
valor = ComboBox1.text
Set busca = Sheets("BOM").Range("A2:A10000").Find(valor, LookIn:=xlValues, LookAt:=xlWhole)
If Not busca Is Nothing Then
Set myRange = Range(busca.Offset(1), ActiveSheet.Range("A1000").End(xlUp))
For Each C In myRange
If C.Interior.ColorIndex = 37 Then
C.Select
End If
Next C
...
2 respuestas
Tuve que reestructurar tu código.
Espero te sirva
Dim dblFil As Double
Sheets("BOM").Select
valor = Range("A1").Value 'ComboBox1.Text
Set busca = Sheets("BOM").Range("A2:A" & Sheets("BOM").Rows.Count).Find(valor, LookIn:=xlValues, LookAt:=xlWhole)
If Not busca Is Nothing And valor <> "" Then
'Set myRange = Range(busca.Offset(1), ActiveSheet.Range("A1000").End(xlUp))
dblFila = busca.Row + 1
Do Until (Range("A" & dblFila).Interior.ColorIndex = 37 Or Range("A" & dblFila).Value = "")
dblFila = dblFila + 1
Loop
If (dblFila - 1) > busca.Row Then
Range("A" & busca.Row + 1 & ":A" & dblFila - 1).Select
Else
Range("A" & busca.Row).Select
End If
End IfS@lu2
En la línea
valor = Range("A1").Value 'ComboBox1.Text
Debiera decir
valor = ComboBox1.Text
Fue un error que arrastré desde las pruebas que hice, lo lamento.
S@lu2
Dim dblFil As Double
Sheets("BOM").Select
valor = ComboBox1.Text
Set busca = Sheets("BOM").Range("A2:A" & Sheets("BOM").Rows.Count).Find(valor, LookIn:=xlValues, LookAt:=xlWhole)
If Not busca Is Nothing And valor <> "" Then
'Set myRange = Range(busca.Offset(1), ActiveSheet.Range("A1000").End(xlUp))
dblFila = busca.Row + 1
Do Until (Range("A" & dblFila).Interior.ColorIndex = 37 Or Range("A" & dblFila).Value = "")
dblFila = dblFila + 1
Loop
If (dblFila - 1) > busca.Row Then
Range("A" & busca.Row & ":A" & dblFila - 1).Select
Else
Range("A" & busca.Row).Select
End If
End If
¡Gracias amigo!... realmente lo que buscaba. Muchas gracias por tu tiempo y tu prontísima respuesta. Funciona genial y se ejecuta muy rápido. Reitero mi gratitud y saludos!!....
Prueba esta macro lo que hace a momento de que abras el formulario es leer tus datos y colocarlos en una matriz de memoria que graba en la hoja con el nombre de productos, luego cuando tecleas un nombre en el textbox busca ese nombre y el nombre siguiente es decir si tecleas producto 1 la macro buscara producto y producto 2, y las filas donde se encuentran luego por una simple resta marca el área de datos correspondiente a producto 1, esta macro esta diseñada para funcionar sin importar cuantos registros agregues o quites, solo añade este código a tu formulario.
Private Sub TextBox1_AfterUpdate()
Set DATOS = Range("PRODUCTOS")
PRODUCTO = TextBox1.Text
LARGO = Len(PRODUCTO)
VALOR = (Val(Right(PRODUCTO, LARGO - 8)))
NPRODUCTO = "PRODUCTO " & VALOR + 1
With DATOS
INDICE = WorksheetFunction.Match(PRODUCTO, .Columns(1), 0)
INDICE2 = WorksheetFunction.Match(NPRODUCTO, .Columns(1), 0)
.Rows(INDICE).Resize(INDICE2 - INDICE).Select
End With
Set DATOS = Nothing
End Sub
Private Sub UserForm_Initialize()
Set DATOS = Range("A1").CurrentRegion
With DATOS
FILAS = .Rows.Count
Set DATOS = .Rows(2).Resize(FILAS - 1)
.Name = "PRODUCTOS"
End With
Set DATOS = Nothing
End Sub