Macro que cambie el Valor de una Celda, Si cumple con 2 Condiciones
Tengo otro inconveniente con otro código, estoy creando una macro que me cambie el valor de una celda si se cumplen 2 condiciones que se encuentran en la misma fila. Ejemplo:
Las condiciones se encuentran en el rango de celda A2 y B2, SI A2="Valor1" Y B2= "Valor2" entonces cambiar el valor de la celda C2. La macro debe evaluar hasta que llegue a las celdas en blanco. Hasta ahora tengo creado el siguiente código:
Sub BuscarDatos()
Application.ScreenUpdating = False
On Error Resume Next
DisplayAlerts = False
Dim uf As String
Dim conta As Integer
F = 2
F1 = 2
F2 = 2
Sheets("Data").Select
Cells(F, 1).Select
While Cells(F, 1) <> Empty
dato = Cells(F, 1)
While Cells(F1, 2) <> Empty
dato1 = Cells(F1, 2)
If dato = 1 And dato1 = 1 Then
Cells(F2, 3).Select
ActiveCell.FormulaR1C1 = "ORANGE"
conta = conta + 1
F2 = F2 + 1
End If
F1 = F1 + 1
Wend
F1 = 2
F = F + 1
Wend
If conta = 0 Then
MsgBox ("No se encontro el código buscado"), vbInformation, "AVISO"
Else
MsgBox ("Se encontraron con éxito " & conta & "códigos"), vbInformation, "AVISO"
End If
DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
El código se ejecuta y me indica cuanto valores coincidieron con las condiciones, pero no me cambia el valor de la columna C en la fila que cumple con la condición, es decir reemplaza en valor de manera consecutiva independientemente donde en la fila donde se encuentre la condición. Mucho agradecería su ayuda ya que no consigo la manera de hacer que funcione de manera correcta.
[Hola
Si mal no te entendí, prueba esto:
Sub Probando()
Dim UltimaFila As Long, Contador As Long
Dim Celda As Range
Application.ScreenUpdating = False
Let UltimaFila = Sheets("DATA").Cells(Rows.Count, 1).End(xlUp).Row
For Each Celda In Sheets("DATA").Range("A2:A" & UltimaFila)
If Celda.Value = 1 And Celda.Offset(0, 1).Value = 1 Then
Celda.Offset(0, 2).Value = "ORANGE"
Let Contador = Contador + 1
End If
Next Celda
If Contador = 0 Then
MsgBox ("No se encontro el código buscado"), vbInformation, "AVISO"
Else
MsgBox ("Se encontraron con éxito " & Contador & " códigos"), vbInformation, "AVISO"
End If
Application.ScreenUpdating = True
End SubComentas
Abraham Valencia
