Combining Code and slight modification

[Doug Mutzig]

Good morning all!

I am hoping you can help me as I am lost on exactly how to accomplish what I want. I have several VBA codes that do different things that I would like to combine if possible.

First I have a 2 codes that add a comment to a cell when the cell’s value is changed. One code seems to work but overwrites the comment each time it is updated (i.e. if I change the value from 1 to 2 I see the comment, if the then change the value from 2 to TD I only see the original 1 listed).

Code by: jfreitag on this post: https://www.mrexcel.com/forum/excel-questions/662266-excel-vba-add-comment-change-cell-value.html

Code:

Option Explicit
Public preValue As Variant
Private Sub worksheet_change(ByVal Target As Range)
If Intersect(Target, Range("J4:P4")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
Target.ClearComments
Target.AddComment.Text Text:="Previous Value was " & preValue & Chr(10) & Chr(10) & "Modified " & Format _
(Date, "mm-dd-yyyy") & Chr(10) & Chr(10) & "By " & Environ("UserName")
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target = "" Then
preValue = "a blank"
Else: preValue = Target.Value
End If
End Sub

I have changed the Range to be a named range (P1Dsched) and removed the Chr(10) linefeeds from the comment text so that everything should be on one line.

The second code does a history of changes by adding to the comment each time a change is made:
Example: 1^st change from 1 to 2, 2^nd change from 2 to td
Comment shows: Doug Mutzig – td
Doug Mutzig – 2

However, I cannot seem to get the code to run in my workbook.

Code posted here: https://www.youtube.com/watch?v=-gWAsXlfHRI

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Dim ws As Worksheet
     For Each c In Target If c.Comment Is Nothing And c.Value = "" Then
With c.AddComment
      .Visible = False
      .Text Application.UserName & "-" & c.Value
End With
     ElseIf Not c.Comment Is Nothing And c.Value = "" Then
             c.Comment.Text Application.UserName & "-" & c.Value & vbNewLine & c.Comment.Text
     End If
Next
End Sub

What I would like to do is get the best of both codes by:

1. Having the comment track the changes as a growing list like the second code, and work like the first code. (I believe the Target.ClearComments part of the 1^st code need to be removed so that previous comments stay, and then a new line added but I am not sure how to accomplish this.)
2. Expand the comment box so that each comment on a change shows on one line
3. Enable the code to work on 2 different ranges on the worksheet. I have a day and a night schedule (P1Dsched, P1Nsched) that I would like to have the code run on.

To add to the complexity I currently have code running in the Worksheet_Change event that looks at the selected ranges (both a day and night named ranges) and makes the texted entered into the cells Uppercase. I am unsure of how to combine everything together or if I can have more than one Worksheet_Change section per worksheet?

I apologize I am not sure where I got the code from.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not (Application.Intersect(Target, Range("P1Dsched")) _
      Is Nothing) Then
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                .Value = UCase(.Value)
                Application.EnableEvents = True
            End If
        End With
    End If
    If Not (Application.Intersect(Target, Range("P1Nsched")) _
      Is Nothing) Then
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                .Value = UCase(.Value)
                Application.EnableEvents = True
            End If
        End With
    End If
End Sub

 Private Sub Worksheet_Change(ByVal Target As Range)
    If Not (Application.Intersect(Target, Range("P5Dsched")) _
      Is Nothing) Then
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                .Value = UCase(.Value)
                Application.EnableEvents = True
            End If
        End With
    End If
    If Not (Application.Intersect(Target, Range("P5Nsched")) _
      Is Nothing) Then
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                .Value = UCase(.Value)
                Application.EnableEvents = True
            End If
        End With
    End If
End Sub

I would like to merge the modified 1^st code that adds comments, with the 2^nd code that changes text to Upper case and add one other code that adds a cell interior fill when a change happens, if a specified cell is not empty.

Code posted by: Gary's Student post from here:https://www.mrexcel.com/forum/excel-questions/662503-change-cells-color-when-any-value-changes.html

Code:

Private Sub Worksheet_Change(ByVal Target As Range)Dim Rng As Range, r As Range
Set Rng = Range("C26:M40")
If Intersect(Target, Rng) Is Nothing Then Exit Sub
For Each r In Target
    Application.EnableEvents = False
        r.Interior.ColorIndex = 4
    Application.EnableEvents = True
Next
End Sub

I have modified by to the following:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, r As Range
Set Rng = Range("P6Dsched")
Set rRng = ActiveSheet.Range("B8")
If IsEmpty(rRng.Value) Then Exit Sub
If Intersect(Target, Rng) Is Nothing Then Exit Sub
For Each r In Target
    Application.EnableEvents = False
        r.Interior.ColorIndex = 46
    Application.EnableEvents = True
Next
End Sub

Is it possible to combine all three codes into one? Is that the most efficient way to do it? or should I have multiple worksheet changes?

Thank you all very much for your help on this!

 

[Doug Mutzig]

Good morning all,

I have been working on the code and believe I have a working combination.

New Code:

Private Sub Worksheet_Change(ByVal Target As Range)    
    Dim c As Range
    Dim ws As Worksheet
    Dim rng As Range, r As Range
    Set rng = Range("P1Dsched")
    Set rng2 = Range("P1Nsched")
    Set rRng = ActiveSheet.Range("A1")
         
    'tracks changes to cells in the worksheet and lists them in comments
    For Each c In Target
        If c.Comment Is Nothing And c.Value <> "" Then
            With c.AddComment
                .Visible = False
                .Text Text:="Prev. Value: " & c.Value & "  Modified: " & Format _
                        (Date, "dd-mmm-yyyy") & "  By: " & Environ("UserName")
            End With
            
         ElseIf Not c.Comment Is Nothing And c.Value <> "" Then
                 c.Comment.Text Text:="Prev. Value: " & c.Value & "  Modified: " & Format _
                        (Date, "dd-mmm-yyyy") & "  By: " & Environ("UserName") & vbNewLine & c.Comment.Text
         End If
    Next
        
        
    'reviews data input into cells of schedule - changes text to uppercase
    If Not (Application.Intersect(Target, Union(rng, rng2)) _
      Is Nothing) Then
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                .Value = UCase(.Value)
                Application.EnableEvents = True
            End If
        End With
    End If
    
    'looks to see if a specific cell has been filled (A1) - if it is then fills interior color of cells (Orange-46) when changed to show a change made after printing to PDF
     If IsEmpty(rRng.Value) Then Exit Sub
    
        If Application.Intersect(Target, Union(rng, rng2)) Is Nothing Then Exit Sub
            For Each r In Target
                Application.EnableEvents = False
                r.Font.Bold = True
                Application.EnableEvents = True
        Next
    
    
End Sub

I have got the code working so that it reviews the cells in the two named ranges I have and changes text to UpperCase (which allows for conditional formatting to work). I also have the comment creation on cell value change working, but it is working on the whole worksheet right now and I would like to limit it to just the two named ranges.

I have both ranges Dim and Set (rng, rng2), but the code for the comments uses the Dim of ws As Worksheet and I am unsure of how to limit the code to just (rng,rng2)

code for the comments (included what is Dim and Set:

 Dim c As Range    Dim ws As Worksheet
    Dim rng As Range, r As Range
    Set rng = Range("P1Dsched")
    Set rng2 = Range("P1Nsched")
    Set rRng = ActiveSheet.Range("A1")
         
    'tracks changes to cells in the worksheet and lists them in comments
    For Each c In Target
        If c.Comment Is Nothing And c.Value <> "" Then
            With c.AddComment
                .Visible = False
                .Text Text:="Prev. Value: " & c.Value & "  Modified: " & Format _
                        (Date, "dd-mmm-yyyy") & "  By: " & Environ("UserName")
            End With
            
         ElseIf Not c.Comment Is Nothing And c.Value <> "" Then
                 c.Comment.Text Text:="Prev. Value: " & c.Value & "  Modified: " & Format _
                        (Date, "dd-mmm-yyyy") & "  By: " & Environ("UserName") & vbNewLine & c.Comment.Text
         End If
    Next

I know I need to do something with the first line

For Each c In Target

but I am not sure what.

I also had to change the code from setting the interior color to making the text bold due to the fact that there is conditional formatting on the set ranges and it would override the vba. I did try having some conditional formatting that would look at the cells and see if the text was bold. If the text was bold it would then conditionally format the cell color; unfortunatlly this would cause excel to crash and I am not sure why. I had to add a function that is used to check for bold text:

I got the code from here: https://answers.microsoft.com/en-us...old-text/180854ef-7730-4b1c-a45f-ac3a8eb30c27

Code:

[COLOR=#000000][FONT=&quot]Function IsBold(rng As Range) As Boolean[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    Application.Volatile[/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]    IsBold = rng.Font.Bold      [/FONT][/COLOR][COLOR=#000000][FONT=&quot][I]'Returns True if Bold and False if Regular[/I][/FONT][/COLOR]
[COLOR=#000000][FONT=&quot]End Function[/FONT][/COLOR]

I have the Bold conditional formatting at the top most conditional rule so that should not be a conflict between this and the other formatting but again excel crashes when I try so I have just stayed with having the text made Bold and not adding a color. To do this I changed to code as follows:

If IsEmpty(rRng.Value) Then Exit Sub    
        If Application.Intersect(Target, Union(rng, rng2)) Is Nothing Then Exit Sub
            For Each r In Target
                Application.EnableEvents = False
                r.Font.Bold = True
                Application.EnableEvents = True

So I have two questions that I am hoping someone can help me with:

1. How do I limit the tracking of changes in comments to my already defined ranges (rng, rng2)
2. Is it possible to do the bold conditional formatting? and does anyone know why it causes a crash?

Thank you for any help you can provide on this!

 

[Doug Mutzig]

I believe I have been able correct my first issue "limit the tracking of changes in comments to my already defined ranges (rng, rng2).

Private Sub Worksheet_Change(ByVal Target As Range)    
    Dim c As Range
    Dim rng As Range, r As Range
    Set rng = Range("P1Dsched")
    Set rng2 = Range("P1Nsched")
    Set rRng = ActiveSheet.Range("A1")
         
       
    'tracks changes to cells in the worksheet and lists them in comments
    
    If Not (Application.Intersect(Target, Union(rng, rng2)) Is Nothing) Then
    For Each c In Target
        If c.Comment Is Nothing And c.Value <> "" Then
            Application.EnableEvents = False
            With c.AddComment
                .Visible = False
                .Text Text:="Prev. Value: " & c.Value & "  Modified: " & Format _
                        (Date, "dd-mmm-yyyy") & "  By: " & Environ("UserName")
            Application.EnableEvents = True
            End With
            
         ElseIf Not c.Comment Is Nothing And c.Value <> "" Then
                Application.EnableEvents = False
                 c.Comment.Text Text:="Prev. Value: " & c.Value & "  Modified: " & Format _
                        (Date, "dd-mmm-yyyy") & "  By: " & Environ("UserName") & vbNewLine & c.Comment.Text
                Application.EnableEvents = True
         End If
    Next
   End If
        
    'reviews data input into cells of schedule - changes text to uppercase
    On Error Resume Next
    If Not (Application.Intersect(Target, Union(rng, rng2)) _
      Is Nothing) Then
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                .Value = UCase(.Value)
                Application.EnableEvents = True
            End If
        End With
    End If
    
    'looks to see if a specific cell has been filled (A1) - if it is then the text in the cell is changed to BOLD to show a change made after printing to PDF
     If IsEmpty(rRng.Value) Then Exit Sub
    
        If Application.Intersect(Target, Union(rng, rng2)) Is Nothing Then Exit Sub
            For Each r In Target
                Application.EnableEvents = False
                r.Font.Bold = True
                Application.EnableEvents = True
        Next
    
    
End Sub

Can someone look through this and see if it is "stable" or follows a correct layout. I know it works I just want to make sure it will continue to work without errors, or if it errors it will not break and stop everything else from working.

Thank you!!