Ver si un dato está duplicado dentro de un periodo entre dos fechas y aplicar un tipo de formato.

Tengo este código, el cual funciona bien, pero aplica el formato condicional a todo el rango indicado en la columna K12:K5000, lo que no logro es que lo aplique solamente a los datos que se filtran tras indicar una fecha en N2 y otra fecha en N3, siempre y cuando estén duplicados entre el periodo de fechas indicado:

<pre>Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
On Error GoTo Err_CommandButton1_Click
Dim fila As Long
Dim lFecha1 As Long, lFecha2 As Long
With Worksheets("A")
If .AutoFilterMode Then
Selection.AutoFilter
End If
End With
Range("J6").Select
ActiveCell.FormulaR1C1 = _
"=SUMIFS(R[6]C[4]:R[4994]C[4],R[6]C[-1]:R[4994]C[-1],Componentes!R[-5]C[-9])"
Range("J7").Select
ActiveCell.FormulaR1C1 = _
"=SUMIFS(R[5]C[5]:R[4993]C[5],R[5]C[-1]:R[4993]C[-1],Componentes!R[-6]C[-9])"
Range("J8").Select
ActiveCell.FormulaR1C1 = "=IF(R[-2]C+R[-1]C>=0.001,R[-1]C/R[-2]C,0)"
Range("K6").Select
ActiveCell.FormulaR1C1 = _
"=SUMIFS(R[6]C[3]:R[4994]C[3],R[6]C[-1]:R[4994]C[-1],TODAY()-1,R[6]C[-2]:R[4994]C[-2],Componentes!R[-5]C[-10])"
Range("K7").Select
ActiveCell.FormulaR1C1 = _
"=SUMIFS(R[5]C[4]:R[4993]C[4],R[5]C[-1]:R[4993]C[-1],TODAY()-1,R[5]C[-2]:R[4993]C[-2],Componentes!R[-6]C[-10])"
Range("K8").Select
ActiveCell.FormulaR1C1 = "=IF(R[-2]C+R[-1]C>=0.001,R[-1]C/R[-2]C,0)"
Range("N6").Select
ActiveCell.FormulaR1C1 = _
"=SUMIFS(R[6]C:R[4994]C,R[6]C[-5]:R[4994]C[-5],Componentes!R[-4]C[-13])"
Range("N7").Select
ActiveCell.FormulaR1C1 = _
"=SUMIFS(R[5]C[1]:R[4993]C[1],R[5]C[-5]:R[4993]C[-5],Componentes!R[-5]C[-13])"
Range("N8").Select
ActiveCell.FormulaR1C1 = "=IF(R[-2]C+R[-1]C>=0.001,R[-1]C/R[-2]C,0)"
Range("O6").Select
ActiveCell.FormulaR1C1 = _
"=SUMIFS(R[6]C[-1]:R[4994]C[-1],R[6]C[-5]:R[4994]C[-5],TODAY()-1,R[6]C[-6]:R[4994]C[-6],Componentes!R[-4]C[-14])"
Range("O7").Select
ActiveCell.FormulaR1C1 = _
"=SUMIFS(R[5]C:R[4993]C,R[5]C[-5]:R[4993]C[-5],TODAY()-1,R[5]C[-6]:R[4993]C[-6],Componentes!R[-5]C[-14])"
Range("O8").Select
ActiveCell.FormulaR1C1 = "=IF(R[-2]C+R[-1]C>=0.001,R[-1]C/R[-2]C,0)"
Range("R6").Select
ActiveCell.FormulaR1C1 = _
"=SUMIFS(R[6]C[-4]:R[4994]C[-4],R[6]C[-9]:R[4994]C[-9],Componentes!R[-3]C[-17])"
Range("R7").Select
ActiveCell.FormulaR1C1 = _
"=SUMIFS(R[5]C[-3]:R[4993]C[-3],R[5]C[-9]:R[4993]C[-9],Componentes!R[-4]C[-17])"
Range("R8").Select
ActiveCell.FormulaR1C1 = "=IF(R[-2]C+R[-1]C>=0.001,R[-1]C/R[-2]C,0)"
Range("S6").Select
ActiveCell.FormulaR1C1 = _
"=SUMIFS(R[6]C[-5]:R[4994]C[-5],R[6]C[-9]:R[4994]C[-9],TODAY()-1,R[6]C[-10]:R[4994]C[-10],Componentes!R[-3]C[-18])"
Range("S7").Select
ActiveCell.FormulaR1C1 = _
"=SUMIFS(R[5]C[-4]:R[4993]C[-4],R[5]C[-9]:R[4993]C[-9],TODAY()-1,R[5]C[-10]:R[4993]C[-10],Componentes!R[-4]C[-18])"
Range("S8").Select
ActiveCell.FormulaR1C1 = "=IF(R[-2]C+R[-1]C>=0.001,R[-1]C/R[-2]C,0)"
Range("J12:J5000").Select
Selection.NumberFormat = "m/d/yyyy"
For fila = Cells(5000, "J").End(xlUp).Row To 1 Step -1
If Cells(fila, 10).Value > 0 Then
Cells(fila, 1).Value = "=LEFT(RC[8],2)"
Cells(fila, 2).Value = Cells(fila, 10).Value
End If
Next
lFecha1 = Range("N2")
lFecha2 = Range("N3")
ActiveSheet.Range("$B$11:$B$5000").AutoFilter Field:=1, Criteria1:=">=" & lFecha1, _
Operator:=xlAnd, Criteria2:="<=" & lFecha2
Range("K12:K5000").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=(CONTAR.SI($K:$K;K12)+CONTAR.SI($K:$K;K12))>2" 'No consigo indicar una función
que me cuente solamente los datos que están dentro del periodo y que aplique el
formato condiocional solomanette a esos datos.
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.14996795556505
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("L12:L5000").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.14996795556505
End With
Selection.FormatConditions(1).StopIfTrue = False
Sheets("A").Select
ActiveSheet.Range("I12").Select
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
Selection.End(xlDown).Select
ActiveWindow.LargeScroll Down:=-5000
Exit_CommandButton1_Click:
Exit Sub
Err_CommandButton1_Click:
MsgBox "Acción no disponible en este momento, asegurese de haber indicado los datos en el Ejecutable .", vbInformation, "Acción no disponible"
Sheets("A").Select
ActiveSheet.Range("I12").Select
Resume Exit_CommandButton1_Click
Application.ScreenUpdating = True
End Sub
Gracias de antemano.</pre>

Añade tu respuesta

Haz clic para o