Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sh1 = "Dashboard"
Sh2 = "Review tracker"
LastRow = Sheets(Sh2).Cells(Rows.Count, "F").End(xlUp).Row
With Sheets(Sh1).Range("A2:J" & LastRow)
.ClearContents
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 1
.ClearComments
End With
Sheets(Sh2).Range("C2:C" & LastRow).Copy
Sheets(Sh1).Range("A2").PasteSpecial xlPasteValues
Sheets(Sh2).Range("F2:F" & LastRow).Copy
Sheets(Sh1).Range("B2").PasteSpecial xlPasteValues
Sheets(Sh2).Range("E2:E" & LastRow).Copy
Sheets(Sh1).Range("C2").PasteSpecial xlPasteValues
Sheets(Sh2).Range("H2:I" & LastRow).Copy
Sheets(Sh1).Range("D2").PasteSpecial xlPasteValues
Sheets(Sh2).Range("I2:I" & LastRow).Copy
Sheets(Sh1).Range("E2").PasteSpecial xlPasteValues
Sheets(Sh2).Range("L2:L" & LastRow).Copy
Sheets(Sh1).Range("F2").PasteSpecial xlPasteValues
Sheets(Sh2).Range("W2:W" & LastRow).Copy
Sheets(Sh1).Range("I2").PasteSpecial xlPasteValues
Sheets(Sh2).Range("Y2:Y" & LastRow).Copy
Sheets(Sh1).Range("J2").PasteSpecial xlPasteValues
With Sheets(Sh1)
With Range("A2:I" & LastRow)
.Borders(xlInsideHorizontal).Color = RGB(255, 255, 255)
.Borders(xlInsideHorizontal).Weight = xlMedium
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.Interior.Color = RGB(242, 242, 242)
End With
Set MyRange = .Range("F2:F" & LastRow)
For Each MyCell In MyRange
Select Case MyCell.Value
Case "Final report issued"
With .Range("F" & MyCell.Row, "I" & MyCell.Row)
.Interior.Color = RGB(0, 172, 141)
.Font.Color = RGB(242, 242, 242)
.HorizontalAlignment = xlCenter
End With
.Range("F" & MyCell.Row, "F" & MyCell.Row).HorizontalAlignment = xlLeft
Case "Audit Announced"
With .Range("F" & MyCell.Row, "F" & MyCell.Row)
.Interior.Color = RGB(0, 172, 141)
.Font.Color = RGB(242, 242, 242)
.HorizontalAlignment = xlLeft
End With
Case "Fieldwork commenced"
With .Range("F" & MyCell.Row, "G" & MyCell.Row)
.Interior.Color = RGB(0, 172, 141)
.Font.Color = RGB(242, 242, 242)
.HorizontalAlignment = xlLeft
End With
Case "Field work completed"
With .Range("F" & MyCell.Row, "H" & MyCell.Row)
.Interior.Color = RGB(0, 172, 141)
.Font.Color = RGB(242, 242, 242)
.HorizontalAlignment = xlLeft
End With
Case "Not yet due"
With .Range("F" & MyCell.Row, "F" & MyCell.Row)
.Font.Color = RGB(84, 130, 53)
.HorizontalAlignment = xlLeft
End With
Case "Deferred"
With .Range("F" & MyCell.Row, "F" & MyCell.Row)
.Font.Color = RGB(0, 51, 204)
.HorizontalAlignment = xlLeft
End With
Case "Cancelled"
With .Range("F" & MyCell.Row, "F" & MyCell.Row)
.Font.Color = RGB(192, 0, 0)
.HorizontalAlignment = xlLeft
End With
Case Else
End Select
MyCell.Value = Empty
Next MyCell
Sheets(Sh2).Range("J2:J" & LastRow).Copy
Sheets(Sh1).Range("F2").PasteSpecial xlPasteValues
Set MyRange = .Range("B2:B" & LastRow)
For Each MyCell In MyRange
If WorksheetFunction.CountIf(MyRange, MyCell.Value) > 1 Then
MyCell.Interior.Color = RGB(217, 217, 217)
End If
Next MyCell
Set MyRange = .Range("J2:J" & LastRow)
For Each MyCell In MyRange
If Not IsEmpty(MyCell) Then
.Range("B" & MyCell.Row).AddComment MyCell.Text
With .Range("B" & MyCell.Row).Comment.Shape.TextFrame.Characters.Font
.ColorIndex = 5
.Size = 9
.Name = "Century Gothic"
End With
.Range("B" & MyCell.Row).Comment.Shape.TextFrame.AutoSize = True
MyCell.Value = Empty
End If
Next MyCell
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Sheets(Sh1).Range("A1").Select
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim KeyRange As Range
Dim ColumnCount As Integer
Dim LastRow As Long
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
ColumnCount = Range("A1:I" & LastRow).Columns.Count
Cancel = False
If Target.Row = 1 And Target.Column <= ColumnCount Then
Cancel = True
Set KeyRange = Range(Target.Address)
Range("A1:I" & LastRow).Sort Key1:=KeyRange, Header:=xlYes
End If
End Sub