• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Place start on a horizontal Monthly timeline if a column has M

janboo

New Member
Hi,
Grateful if someone can assist. If type in column C is = "M", I need a Star along the horizontal monthly columns based on the End date in column E.

thanks in advance for assistance and help!


Tasks/MilestonesTypeStart
Date
End
Date
Q3 2021Q4 2021
30-Sep-202130-Oct-202130-Nov-202130-Dec-2021
grapesM1-May-20211-Sep-2021blue star goes here
applesM27-Sep-202129-Oct-2021
blue star goes here
orangesM27-Sep-20213-Dec-2021blue star goes here
 
Hi, could be done by formula or by code but as it depends on how smart is the worksheet​
so according to this forum rules attach at least a workbook …​
 
Hi Marc,
Sorry, attached is the file. Much appreciated.
 

Attachments

  • fruits.xlsx
    87.2 KB · Views: 8
Last edited by a moderator:
According to your attachment a VBA demonstration for starters :​
Code:
Sub Demo1()
    Dim V, R&, W
        V = Evaluate(Replace("IF({1},YEAR(#)&"" ""&MONTH(#))", "#", Range("H3", [H3].End(xlToRight)).Address))
        Application.ScreenUpdating = False
    For R = 4 To Cells(Rows.Count, 5).End(xlUp).Row
        With Cells(R, 5)
                W = Application.Match(Year(.Value2) & " " & Month(.Value2), V, 0)
            If IsNumeric(W) Then
                With .Cells(1, W + 3)
                     .Font.Color = vbBlue
                     .HorizontalAlignment = xlCenter
                     .Value2 = ChrW(9733)
                End With
            End If
        End With
    Next
        Application.ScreenUpdating = True
End Sub
Do you like it ? So thanks to click on bottom right Like !
 
Thank you very much Marc L for your help! Sincerely appreciate your time and effort!!

If Column Type (column C) is other than "M", i didn't want star in the date column. Can you help adjust your macro please? Thanks again!!
 
Last edited by a moderator:
'Cause it was not necessary with your sample attachment with only M !​
Anyway the revamped demonstration :​
Code:
Sub Demo1r()
    Dim V, R&, W
        V = Evaluate(Replace("IF({1},YEAR(#)&"" ""&MONTH(#))", "#", Range("H3", [H3].End(xlToRight)).Address))
        Application.ScreenUpdating = False
    For R = 4 To Cells(Rows.Count, 5).End(xlUp).Row
        If Cells(R, 3).Text = "M" Then
            With Cells(R, 5)
                   W = Application.Match(Year(.Value2) & " " & Month(.Value2), V, 0)
                If IsNumeric(W) Then
                    With .Cells(1, W + 3)
                         .Font.Color = vbBlue
                         .HorizontalAlignment = xlCenter
                         .Value2 = ChrW(9733)
                    End With
                End If
            End With
        End If
    Next
        Application.ScreenUpdating = True
End Sub
You should Like it !​
 
Hi,
Thank you in advance for your help!
Can someone help tweak this formula Marc L wrote for me where instead of Text = "M", I need help if the Text = to "C", to have red star , if it has "S", blue star. If Text has both "C,S", would like both blue and red star in the same cell?
And if possible a way to wipe out the stars if the dates have changed?

thanks sincerely for all your help!!!
 

Attachments

  • fruits 2.xlsm
    95.6 KB · Views: 1
Last edited by a moderator:
According to the previous post :​
Code:
Sub Demo2()
  Const F = "IFERROR(YEAR(#)&"" ""&MONTH(#),"
    Dim R&, V, W, C%
        R = Cells(Rows.Count, 5).End(xlUp).Row:  If R < 4 Then Beep: Exit Sub
        V = Evaluate(Replace(F, "#", Range("H3", [H3].End(xlToRight)).Address) & "0)")
        W = Evaluate("IFERROR(SEARCH({""C"",""S""},C4:C" & R & "),0)")
        Range("H4:H" & R).Resize(, UBound(V)).ClearContents
    With Application
        V = .IfError(.Match(Evaluate(Replace(F, "#", "E4:E" & R) & """"")"), V, 0), 0)
       .ScreenUpdating = False
    For R = 1 To UBound(V)
        If V(R, 1) Then
            For C = 1 To UBound(W, 2)
                If W(R, C) Then
                    With Cells(R + 3, V(R, 1) + 7)
                        .HorizontalAlignment = xlCenter
                        .Value2 = .Text & ChrW(9733)
                        .Characters(Len(.Text)).Font.Color = Array(vbRed, vbBlue)(C - 1)
                    End With
                End If
            Next
        End If
    Next
       .ScreenUpdating = True
    End With
End Sub
You may Like it !​
 
Back
Top