Sub Formatting_click()
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
'jindon code
Dim Cell As Range, ff As String
With ThisWorkbook.Sheets("main")
With .Columns("a")
Set Cell = .Find("*Rec ID", , , 1)
If Not Cell Is Nothing Then
ff = Cell.Address
Do
Cell.Font.Color = RGB(65, 105, 225)
Cell.Font.Bold = True
Set Cell = .FindNext(Cell)
Loop Until ff = Cell.Address
Set Cell = Nothing
End If
Set Cell = .Find("Data Mapunit Rec ID", , , 1)
If Not Cell Is Nothing Then
ff = Cell.Address
Do
With Cell(2)
.Font.Bold = True
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.Interior.Color = RGB(255, 255, 204)
End With
Set Cell = .FindNext(Cell)
Loop Until ff = Cell.Address
Set Cell = Nothing
End If
End With
.Range("A1:AK2").Interior.Color = RGB(255, 255, 204)
.Range("AM1:BX2").Interior.Color = RGB(204, 255, 204)
.Range("A1").Value = "DMU-COMPARE-TOOL"
.Range("A1").Font.Color = RGB(65, 105, 225)
.Range("A1").Font.Bold = True
.Range("A1:BX2").Cells.WrapText = False
Lastrow = ThisWorkbook.Worksheets("Main").Cells(Rows.Count, "A").End(xlUp).Row
.Cells.FormatConditions.Delete
With .Range("a3:ak" & Lastrow)
.FormatConditions.Add 2, , "=isnumber(search(""id"",$a3))"
.FormatConditions(1).Interior.Color = RGB(225, 225, 225)
.FormatConditions(1).Borders.LineStyle = xlContinuous
.FormatConditions(1).Borders.Weight = xlThin
End With
With .Range("b3:ak" & Lastrow)
.FormatConditions.Add 2, , "=b3<>an3"
.FormatConditions(2).Font.Color = vbRed
With .Offset(, 38)
.FormatConditions.Add 2, , "=an2<>b2"
.FormatConditions(1).Font.Color = vbRed
End With
End With
Dim myCols, myVals, x, y
myCols = Array(19, 33, "3:14")
myVals = Array("FL Ecol Comm *", "SIR*", Array("*4 L", "*4 R", "*4 H", "*10 L", "*10 R", _
"*10 H", "*40 L", "*40 R", "*40 H", "*200 L", "*200 R", "*200 H"))
For r = 0 To UBound(myCols)
If r < 2 Then
x = Split(myCols(r), ":")
y = Split(myVals(r), ":")
Else
x = Evaluate("transpose(row(" & myCols(r) & "))")
ReDim Preserve x(0 To UBound(x) - 1)
y = myVals(2)
End If
For rr = 0 To UBound(x)
Set Cell = .Columns(Val(x(rr))).Find(y(rr), , , 1)
If Not Cell Is Nothing Then
ff = Cell.Address
Do
Cell.Font.Color = vbBlack
Set Cell = .Columns(Val(x(rr))).FindNext(Cell)
Loop Until ff = Cell.Address
Set Cell = Nothing
End If
Next
Next
.Select
.Range("A4").Select
End With
'end jindon code
'Call ProtectAllSheets
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.StatusBar = Empty
End With
End Sub
Bookmarks