Create Insert Date Macro

0

I understand that Excel has a macro using "CTRL ; " - This is exactly what I want because it inserts the date anywhere that I have the cursor.

For example in a large field I have a line per task date . (I merged cells etc)

17-05-2019 Do this (ctrl + enter for a new line)

15-05-2019 Do something else

11-05-2019 Do whatever you think is right.

Not only do I want to enter the date with a macro, but I want to be able to control the format of the date and also the font color.

format = dd mmm, yyyy

color = dark blue

Answer
Discuss

Discussion

Thanks for replying....this is not going to do what I want though.
I've made a large cell so I can input alot of text. Even if I set the format of the cell to the date format I want, the date format is not respected. because there is other text in it the same cell that is not a date. Formatting the colour of the cell will also change the color of the entire text when I only want part of the text (the date) to be a different color.
TinaC May 18, '19 at 8:00 am
Hi Tina,
Creating a large, merged cell goes agains the essence of Excel. Consider using Word or split the 6 bits of information you want to show into 6 cells. But if you absolutely must use Excel and must merge it all into one cell (whether this is a merged cell or not - consider showing a textbox) then you need an input form (a userform) with 6 textboxes into which you can enter your data. When you click OK the bits are assembled into a formatted string which is placed in the destination cell or textbox on the sheet.
This sounds easier than it is. The first problem is how to call up the form (say, by clicking in the target cell or by adding a button to the context menu). Then, what to do with text that might already exist in the target container (you might wish to load existing text into the form when it opens). You would need a couple of checkboxes or radio buttons on the form to specify the colour of each bit of data that you want colour coded. A programmer would work for a day to write the program after a day of asking questions about how every detail is to be handled. I suggest you work out the details of your requirement in sufficient detail to be able to split your request into several parts - with a hefty portion of own content.
Variatus (rep: 2678) May 21, '19 at 12:58 am
Add to Discussion

Answers

0

Existing code is probably the most important part of a question (because without it it's a request), and posting it in an "Answer" - which is to say a "Solution" - may not have added to the clarity of your post but it set me thinking and this is the answer I came up with. Paste the code in a standard code module and call the sub AddDate with a suitable keyboard shortcut.

Sub AddDate()
    ' 26 May 2019

    Const DatFmt As String = "dd mmm, yyyy"

    Dim CellVal As String
    Dim Sp() As String
    Dim n As Integer, p As Integer
    Dim HasDate() As Boolean
    Dim i As Integer

    With ActiveCell
        CellVal = Trim(.Value)                      ' remove leading / trailing blanks
        Sp = Split(CellVal, Chr(10))                ' split CellVal into lines
        n = UBound(Sp)
        If n > -1 Then
            ' the cell isn't blank
            ReDim HasDate(n)
            For i = 0 To n
                HasDate(i) = FormatDate(Sp(i), DatFmt)
            Next i

            ' return formatted text to cell and colour the dates
            CellVal = Join(Sp, Chr(10))
            .Value = CellVal
            .Font.ColorIndex = xlAutomatic
            For i = 0 To n
                If HasDate(i) Then
                    If i Then p = InStr(WorksheetFunction.Substitute(CellVal, Chr(10), Chr(160), i), Chr(160))
                    .Characters(p + 1, Len(DatFmt)).Font.Color = 12611584
                End If
            Next i
        End If
    End With
End Sub

Private Function FormatDate(Txt As String, _
                            Fmt As String) As Boolean
    ' 26 May 2019

    Dim Sp() As String
    Dim DatVal As Variant
    Dim n As Integer

    Sp = Split(Txt)
    n = UBound(Sp)
    If n > -1 Then
        ' the line isn't blank
        If IsDate(Sp(0)) Then
            ' the first word is a date
            Sp(0) = Format(Sp(0), Fmt)
            Txt = Join(Sp)
            FormatDate = True
        Else
            ' check if the line already has a formatted date
            If n >= UBound(Split(Fmt)) Then
                FormatDate = IsDate(Sp(0) & " " & Sp(1) & " " & Sp(2))
            End If
        End If
    End If
End Function

The rules are simple. The code will look for a date at the beginning of each line of text in the cell. The "beginning" is either at the start or after a line break (Alt+Return). If there is a short date at the beginning of a line it will be formatted on the pattern given by the constant DatFmt. A "short" date is a date contained in a single word, such as you would be able to insert using Ctl+;. Note that you could change that format to consist of several words. My code wouldn't recognise that as a "date" however. It looks for one word, uninterrupted by spaces.

If no such word is found at the beginning of a text line the code checks whether an already formatted date, consisting of 3 words (match DatFmt), exists. Such dates, as well as those reformatted in the step above, will be coloured blue. All the rest of the text is given the default colour (black, unless you changed it). Dates in a different format or not at the beginning of a line will neither be formatted nor coloured. I tried to anticipate leading or trailing blanks which might upset the recognition system but extra invisible characters is what you should look for whenever the program doesn't do what you expect.

Such, you will be able to write the entire text of a cell with several dates in it, each at the beginning of a new line, and then run the code to give the format. I abstained from adding the dash into the date format because you will want to treat it as part of the text format, not the date format. However, you can add it to the value of constant DatFmt if you so wish. I also decided against inserting today's date automatically because you can insert it error-free with Ctl+; which is faster to do than insert a placeholder.

Discuss

Discussion

I wonder how you made out with the code I provided.
Variatus (rep: 2678) May 28, '19 at 8:52 pm
Add to Discussion
0

I am going with the code below as it does mostly what I want. (except for the font colour)

Sub addDate()

      Dim sourceSheet As Worksheet

      Set sourceSheet = Sheets("Form")

      sourceSheet.Range("E15").Activate

      'Add to beginning of cell

       With ActiveCell

            .Value = Format(Date, "DD MMM YYYY - ") & vbNewLine & .Value

        End With

        'Add to end of text in cell

        'ActiveCell.Characters(Len(sourceSheet.Range("E15")) + 1, 12).Insert Format(Date, "DD MMM, YYYY - ")

End Sub

Discuss

Answer the Question

You must create an account to use the forum. Create an Account or Login