VBA - color the task, which has been sign by X

[maxblack]

Hello Collegues,

I need your help following idea. I have a table with employees where I insert, what they will be doing particular day. To make it more readable I have following idea:

When Perons 1 will choose her name, cells in row 2, where we have tasks, which have to done will be coloured. Which task should be coloured should be based on X inserted in row of that person. I try to figure it out how to do this using VBA.

I would be grateful for your support.
Thanks
max

21/04/2017

Task 1

Task 2

Task 3

Task 4

Task 5

Task 6

Task 7

Task 8

Task 9

Task 10

Task 11

Task 12

Task 13

Task 14

Task 15

P1

X

P2

X

X

P3

X

X

X

P4

X

X

X

P5

X

X

X

P6

X

X

P7

X

X

P8

X

X

P9

X

X

P10

X

X

P11

X

X

P12

X

X

<tbody>
</tbody>

I had no ide how to attach something.

 

[maxblack]

Thanks again

If I would like to set that active cells in top row (header) are only from B1 to D1, not whole row?

 

[maxblack]

I have weird situation, If I have in A1 cell for example "27/04/2017" highlighting and clearing is working correctly, but when I change the text into "FILE" or something else its not working at all.

 

[Nishant94]

Yes it is working based on the assumption that top leftmost corner of every table in the sheet will have a date.

What else can it have other than date?

 

[maxblack]

It could be for example "Monday"

 

[maxblack]

is it possible to fix it somehow?

 

[maxon]

Hi, I have to back to my old thread with one more question regarding the code:

My macro consist of two part, one is Worksheet_SelectionChange(ByVal Target As Range) with following code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

On Error Resume Next

Application.ScreenUpdating = False
Application.EnableEvents = False

    Dim MatrixRng As Range, DataRange As Range, check As Boolean
    Dim LastRow As Integer, icounter As Integer
    Dim rng As Range, Rng2 As Range, CheckCell As Boolean

If ThisWorkbook.Sheets("STATS").Range("R2").Value = "OFF" Then
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
End If

    Set rng = Target.End(xlToLeft)
    If IsDate(Target.Value) Or UCase(Target.Value) = "MONDAY" Or UCase(Target.Value) = "TUESDAY" Or _
                UCase(Target.Value) = "WEDNESDAY" Or UCase(Target.Value) = "THURSDAY" Or _
                UCase(Target.Value) = "FRIDAY" Or UCase(Target.Value) = "SATURDAY" Or _
                UCase(Target.Value) = "SUNDAY" Then
        LastRow = Range(Target, Target.End(xlDown)).Cells.Count - 1
        icounter = 1
        Do Until icounter = LastRow Or check = True
            If Target.Offset(icounter, 0).Interior.Color <> vbYellow Then
                check = True
                Target.Offset(icounter, 0).Copy
            End If
            icounter = icounter + 1
        Loop
        Range(Target.Offset(1, 0), Target.End(xlDown)).PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
        Application.EnableEvents = False
        Target.Select
        Application.EnableEvents = True
        Exit Sub
    End If
    LastRow = Range(rng, rng.End(xlDown)).Cells.Count - 1
    If IsDate(rng.Value) Or UCase(rng.Value) = "MONDAY" Or UCase(rng.Value) = "TUESDAY" Or _
                UCase(rng.Value) = "WEDNESDAY" Or UCase(rng.Value) = "THURSDAY" Or _
                UCase(rng.Value) = "FRIDAY" Or UCase(rng.Value) = "SATURDAY" Or _
                UCase(rng.Value) = "SUNDAY" Then
        icounter = 1
        Do Until icounter = LastRow Or check = True
            If rng.Offset(icounter, 0).Interior.Color <> vbYellow Then
                check = True
                rng.Offset(icounter, 0).Copy
            End If
            icounter = icounter + 1
         Loop
        Range(rng.Offset(1, 0), rng.Offset(LastRow, 0)).PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
        Target.Select
        Set MatrixRng = Range(rng, rng.End(xlToRight))
         If Not Intersect(Target, MatrixRng) Is Nothing Then
            Set DataRange = Range(Target.Offset(1, 0), Target.Offset(LastRow, 0))
            For Each Rng2 In DataRange
                If Not IsEmpty(Rng2) Then
                    Rng2.Offset(0, -Rng2.Column + rng.Column).Interior.Color = vbYellow
                End If
            Next Rng2
         End If
    End If
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

and second part is Sub part.

I have in sheet ON/OFF button, and I would like to turn off the above code when I have OFF selected.
i have inserted below code in Worksheet_SelectionChange but it doesnt work at all

If ThisWorkbook.Sheets("STATS").Range("R2").Value = "OFF" Then
    Application.EnableEvents = False
Else
    Application.EnableEvents = True
End If

i have to change it, becouse when I use OFF button I would like to update the data into sheet and currently its making lot of mess when I press somewhere


thanks for help in advance!