Macro para Excel 2007 para Buscar con dos condiciones en un Libro diferente.

Me podrías mandar los libros para hacer pruebas.

Mi correo es

[email protected]

Hola, te acabo de pasar los dos libros vía email.
Saludos.

Pues creo que ya lo tengo. Los llame LibroUno y LibroDos para que no se confundiesen con el nombre estándar. La pena es que me ha borrado los datos sobrantes de LibroUno

Para probarlo añade datos y pon fuente normal en la columna última. Si añades datos no olvides rellenar la primera columna porque cuando encuentre una celda vacía da por terminada la lista.

Ahora preparo el mensaje y te envío los ficheros. No olvides puntuar si ya está bien o pedirme las modificaciones que necesites.

Excelente, funciona correctamente, sin embargo, tengo dos consultas:

1) En el momento que la cantidad de productos (LibroDos) aumente (ejemplo: Producto 11) se deberá modificar el macro, la consulta es: ¿existe la posibilidad de que el Macro cuente la cantidad de productos en vez de tomar por defecto el número 10?

2) Para ejecutar el Macro se necesita tener abierto el LibroDos, ¿existe la posibilidad de que el Macro se ejecute con el LibroDos cerrado? (Tomando en cuenta de que el mismo siempre se encontrará en la misma ubicación en la máquina local, ejm: C:\Parametros\LibroDos.xlsx).

Quedo a la espera de tu respuesta.

Saludos.

Si, ambas cosas me parecen posibles en principio.

Ahora que lo veo puse código extra porque al principio pensaba hacerlo de otra forma y al final resulto más sencillo. Quito el código extra y además la condición 1 que dices se cumple sin tener que añadir nada de código.

Y la segunda se puede hacer fácilmente si la ubicación es fija, basta con que la macro abra el fichero "C:\parámetros\LibroDos.xlsx" en caso de que no esté abierto.

La nueva macro sería esta:

Private Sub BotonCumplir_Click()
Dim i, Produ As Integer
Dim cumpli As Double
Dim EstaAbierto As Boolean
EstaAbierto = False
For i = 1 To Workbooks.Count
  If Workbooks(i).Name = "LibroDos.xlsx" Then
    EstaAbierto = True
    Exit For
  End If
Next
If Not EstaAbierto Then
   Workbooks.Open ("C:\parametros\LibroDos.xlsx")
   Application.Workbooks("LibroUno.xlsm").Activate
End If
i = 2
While Cells(i, 1).Text <> ""
   Produ = Val(Right$(Cells(i, 3), 2))
   cumpli = CDbl(Application.Workbooks("LibroDos.xlsx").Sheets(1).Cells(Produ + 1, 3))
   If CDbl(Cells(i, 6)) < cumpli Then
     Cells(i, 1).EntireRow.Delete
   Else
     Cells(i, 6).Interior.Color = vbYellow
     Cells(i, 6).Font.Color = vbRed
     Cells(i, 6).Font.Bold = True
     i = i + 1
   End If
Wend
End Sub

De todas formas ahora te mando los ficheros.