Macro que realice un formato condoicional

Tengo una macro que me pone formato condicionales, me asesoro una experta de este foro.

Quisiera saber como actualizar un requerimiento mas que me pide almacén.

Lo que Hace la macro es resaltar de amarillo si tengo series repetidas.

Pero lo que necesito que también identifique todas las series que empiezan con "S01*******" Es decir, hay algunas series que empiezan con SO19494DDKKD (empiezan las 3 primeras con S01 el resto numeración es variable), Basta que empiece con S01 para que las resalte de fondo rojo y letras blancas. Foto de ejemplo.

El rango empieza del k3 hacia las columnas de adelante.

Adjunto la programación a ver en donde se puede actualizar.

Sub Transponer_Series()
'Por Elsa Matilde

Application.ScreenUpdating = False

'borrar posibles formatos anteriores
Cells.FormatConditions.Delete

'transponer el total de la col C a la fila 2 a partir de K
filx = Range("D" & Rows.Count).End(xlUp).Row
Range("D2:D" & filx).Copy
Range("K2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("K1").Select
Application.CutCopyMode = False
'Formulas CONTARA. Rango absoluto.
[K1].FormulaR1C1 = "=COUNTA(R3C:R2000C)"
Range("K1").AutoFill Destination:=Range("K1:T1"), Type:=xlFillDefault

'Fto. Condicional a partir de fila 3 hasta todas las filas posibles. Se le ha puesto hasta un rango de 3.000
Range("K3:K3000").Select
Range("K3").Activate
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=CONTAR.SI(K$3:K3,K3)>1" 'Detectamos las series que pueden repetirse por error de escaneo
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
'se copia el fto condicional al resto de las col
y = Range("IV2").End(xlToLeft).Column
For x = 12 To y
Range("K3:K3000").Copy
Cells(3, x).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Next x
'contenido y formato a J1
[J1] = "Contador de Series"
With [J1]
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
.ReadingOrder = xlContext
End With
With [J1].Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With [J1].Font
.Bold = True
.Name = "Franklin Gothic Demi Cond"
.Size = 14
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
'formato a celdas de fila 1 a partir de K
Range(Cells(1, 11), Cells(1, y)).Select
With Selection.Font
.Name = "Franklin Gothic Demi Cond"
.Size = 22
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.ReadingOrder = xlContext
End With

'Formato condicional en fila 1 a partir de K
x = 2 '1° fila en col F
For i = 11 To y 'El buccle For Next repito las instrucciones tantas veces como sea posible
Cells(1, i).Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=$F$" & x
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="=$F$" & x
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
x = x + 1
Next i

'ajustar ancho a las col ocupadas
Range("K1:" & Cells(1, y).Address).ColumnWidth = 13
End Sub

Añade tu respuesta

Haz clic para o