VBA Code to Add Additional Note in Cell if it already has a value in it

B

bmkelly

Board Regular
Joined
Mar 26, 2020
Messages
172
Office Version
  1. 365
Platform
  1. Windows
Hello,

I have a few different Macros that will look for specifics in the Data and add a Note in a Column. However I am wondering if there is a way that I can have the code add a note in addition to a note that may already be in that cell?

Example: If data shows its a High Dollar Device and adds a note in stating "Review- High Dollar Device" but if the data also has a Missing Coverage on top of that High Dollar Device - it will then therefore get overwritten by Missing Coverage and will say "Review -Missing Coverage" now... Ideally I would like for it to add onto the note so end result would be "Review - High Dollar Device and Missing Coverage"

Below are the different Macros I have running that add Notes

VBA Code: 
Sub BlankWarranty()

'Looks for Additions with a Blank Warranty in WarrantyEnd Column'

    Dim r1 As String
    Dim r2 As String
    Dim lr As Long
  
        lr = Range("M" & Rows.Count).End(3).Row 'Transaction Type'
        r1 = Range("M2:M" & lr).Address 'Transaction Type'
        r2 = Range("O2:O" & lr).Address 'WarrantyEnd'
  
  'Notes added in Site Manager Notes'
    Range("U2:U" & lr).Value = Evaluate("=IF(" & r1 & "=""Addition"",IF(ISBLANK(" & r2 & "),""Review - Blank Warranty Addition"",""""),"""")")

End Sub

VBA Code: 
Sub HighDollarDevice()

Dim BCol As Range
Dim ACol As Range
   
    Set BCol = Range("1:1").Find("BDS Unit Price", , , xlWhole, , , False, , False)
    Set ACol = Range("1:1").Find("Site Manager Notes", , , xlWhole, , , False, , False)
        
        If BCol Is Nothing Or ACol Is Nothing Then
            MsgBox "BDS Unit Price Column Not Found"
        Exit Sub
        
    End If
    
    With Range(BCol.Offset(1), Cells(Rows.Count, BCol.Column).End(xlUp)).Offset(, ACol.Column - BCol.Column)
        .Value = Evaluate(Replace(Replace("if(#>4999,""Review - High Dollar Device"",if(@="""","""",@))", "@", .Address), "#", .Offset(, BCol.Column - ACol.Column).Address))

    End With
        
End Sub

VBA Code: 
Sub LowDollarDevice()

Dim BDSCol As Range
Dim SMNCol As Range
   
    Set BDSCol = Range("1:1").Find("BDS Unit Price", , , xlWhole, , , False, , False)
    Set SMNCol = Range("1:1").Find("Site Manager Notes", , , xlWhole, , , False, , False)
        
        If BDSCol Is Nothing Or SMNCol Is Nothing Then
            MsgBox "Column Not Found"
        Exit Sub
        
    End If
    
    With Range(BDSCol.Offset(1), Cells(Rows.Count, BDSCol.Column).End(xlUp)).Offset(, SMNCol.Column - BDSCol.Column)
        .Value = Evaluate(Replace(Replace("if(#<-4999,""Review - Low Dollar Device"",if(@="""","""",@))", "@", .Address), "#", .Offset(, BDSCol.Column - SMNCol.Column).Address))

    End With
        
End Sub

VBA Code: 
Sub UnderContract()

Dim VCol As Range
Dim ACol As Range
   
    Set VCol = Range("1:1").Find("VendorContract", , , xlWhole, , , False, , False)
    Set ACol = Range("1:1").Find("Site Manager Notes", , , xlWhole, , , False, , False)
   
        If VCol Is Nothing Or ACol Is Nothing Then
            MsgBox "VendorContract Column Not Found"
        Exit Sub
        
    End If
   
        With Range(VCol.Offset(1), Cells(Rows.Count, VCol.Column).End(xlUp))
            .SpecialCells(xlConstants).Offset(, ACol.Column - VCol.Column).Value = "Review - Contract"
        
        End With
        
End Sub

VBA Code: 
Sub Proration()

Dim PCol As Range
Dim ACol As Range
   
    Set PCol = Range("1:1").Find("Proration Date", , , xlWhole, , , False, , False)
    Set ACol = Range("1:1").Find("Site Manager Notes", , , xlWhole, , , False, , False)
   
        If PCol Is Nothing Or ACol Is Nothing Then
            MsgBox "Proration Date Column Not Found"
        Exit Sub
        
    End If
   
        With Range(PCol.Offset(1), Cells(Rows.Count, PCol.Column).End(xlUp))
            .SpecialCells(xlConstants).Offset(, ACol.Column - PCol.Column).Value = "Review - Prorate?"
        
        End With
        
End Sub

VBA Code: 
Sub MissingCoverage()

'Looks for Missing Coverage in Coverage Column'

Dim CCol As Range
Dim SMNCol As Range
  
    Set CCol = Range("1:1").Find("Coverage", , , xlWhole, , , False, , False)
        If CCol Is Nothing Then
            MsgBox "Coverage Column Not Found"
        Exit Sub
        
    End If
   
    Set SMNCol = Range("1:1").Find("Site Manager Notes", , , xlWhole, , , False, , False)
        If SMNCol Is Nothing Then
            MsgBox "Site Manager Notes Column Not Found"
        Exit Sub
        
    End If
  
    With CCol.EntireColumn
        .Replace "Missing Coverage", "=true", xlWhole, , False, , False, False
            On Error Resume Next
        .SpecialCells(xlFormulas, xlLogical).Offset(, SMNCol.Column - .Column).Value = "Review - Missing Coverage"
            On Error GoTo 0
        .Replace "=true", "Missing Coverage", xlWhole, , False, , False, False
   End With
   
End Sub

VBA Code: 
Sub Reactivations()

'Looks for Missing Coverage in Coverage Column'

Dim NCol As Range
Dim SMNCol As Range
  
    Set NCol = Range("1:1").Find("Notes", , , xlWhole, , , False, , False)
        If NCol Is Nothing Then
            MsgBox "Notes Column Not Found"
        Exit Sub
        
    End If
   
    Set SMNCol = Range("1:1").Find("Site Manager Notes", , , xlWhole, , , False, , False)
        If SMNCol Is Nothing Then
            MsgBox "Site Manager Notes Column Not Found"
        Exit Sub
        
    End If
  
    With NCol.EntireColumn
        .Replace "Standard Reactivations", "=true", xlWhole, , False, , False, False
            On Error Resume Next
        .SpecialCells(xlFormulas, xlLogical).Offset(, SMNCol.Column - .Column).Value = "Reactivation"
            On Error GoTo 0
        .Replace "=true", "Standard Reactivations", xlWhole, , False, , False, False
   End With
   
End Sub

Thank you for your help in advance!
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Sort by date Sort by votes
I take it that these notes are just cell data and not the notes/comments that you add to a cell using Alt+I+M ?
Then consider variables and concatenation.

VBA Code: 
Sub BlankWarranty()
Dim strNoteA As String, strNoteB As String, r1 As String, r2 As String
Dim lr As Long

'Looks for Additions with a Blank Warranty in WarrantyEnd Column'
lr = Range("M" & Rows.Count).End(3).Row 'Transaction Type'
r1 = Range("M2:M" & lr).Address 'Transaction Type'
r2 = Range("O2:O" & lr).Address 'WarrantyEnd'

'Notes added in Site Manager Notes'
strNoteA = Range("U2:U" & lr)
strNoteB = Evaluate("=IF(" & r1 & "=""Addition"",IF(ISBLANK(" & r2 & "),""Review - Blank Warranty Addition"",""""),"""")")
If strNoteA = "" Then
  Range("U2:U" & lr) = strNoteB
Else
  Range("U2:U" & lr) = strNoteA & vbCrLf & strNoteB
End If

End Sub
I confess that I have no idea what that formula does so I left it in there. Methinks you don't need it, just need the text you want to append. If that works and you intend to use it in several subs, I might make the part that does the test and concatenation into a separate function, passing the cell address and performing the IF block part. Then again, that's my Access vba brain. Trying to learn more Excel vba & I find the business of where to put code and/or how to write it so that it can "see" a particular sheet is something I'm still learning.
 
Last edited:
Upvote 0
Micron said:
I take it that these notes are just cell data and not the notes/comments that you add to a cell using Alt+I+M ?
Then consider variables and concatenation.

VBA Code: 
Sub BlankWarranty()
Dim strNoteA As String, strNoteB As String, r1 As String, r2 As String
Dim lr As Long

'Looks for Additions with a Blank Warranty in WarrantyEnd Column'
lr = Range("M" & Rows.Count).End(3).Row 'Transaction Type'
r1 = Range("M2:M" & lr).Address 'Transaction Type'
r2 = Range("O2:O" & lr).Address 'WarrantyEnd'

'Notes added in Site Manager Notes'
strNoteA = Range("U2:U" & lr)
strNoteB = Evaluate("=IF(" & r1 & "=""Addition"",IF(ISBLANK(" & r2 & "),""Review - Blank Warranty Addition"",""""),"""")")
If strNoteA = "" Then
  Range("U2:U" & lr) = strNoteB
Else
  Range("U2:U" & lr) = strNoteA & vbCrLf & strNoteB
End If

End Sub
I confess that I have no idea what that formula does so I left it in there. Methinks you don't need it, just need the text you want to append. If that works and you intend to use it in several subs, I might make the part that does the test and concatenation into a separate function, passing the cell address and performing the IF block part. Then again, that's my Access vba brain. Trying to learn more Excel vba & I find the business of where to put code and/or how to write it so that it can "see" a particular sheet is something I'm still learning.
Click to expand...
Correct, these are just notes that are cell data! An individual on here was able to provide me with the following code where instead of looking at column letters it goes by column headers which is what I am looking for. Only issue I have with this is how to incorporate the "
'Insert Note After Existing Note'
.Cells(cel.Row, SMNCol.Column).Value = .Cells(cel.Row, SMNCol.Column).Value & " " & note" into the other subs (which i actually just combined all my subs into one and it still ran accurately)
VBA Code: 
'Blank Warranty Addition'
    Dim TTCol As Range
    Dim WECol As Range
    Dim SMNCol As Range
    Dim rng As Range
    Dim cel As Range
    Dim LR As Long
    Dim note As String
    
    note = "Review - Blank Warranty Addition"

    Application.ScreenUpdating = False

        With Sheets("Export Detail")
        
    'TheSheet.Range.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)'
        Set TTCol = .Range("1:1").Find("Transaction Type", , xlValues, xlWhole)
        Set WECol = .Range("1:1").Find("WarrantyEnd", , xlValues, xlWhole)
        Set SMNCol = .Range("1:1").Find("Site Manager Notes", , xlValues, xlWhole)

        LR = .Cells(.Rows.Count, TTCol.Column).End(xlUp).Row
    
        Set rng = .Range(.Cells(2, TTCol.Column), .Cells(LR, TTCol.Column))
            For Each cel In rng
                If cel.Value = "Addition" Then
                If .Cells(cel.Row, WECol.Column) = "" Then
            'USE ONLY ONE OF THE FOLLOWING'
            'Overwrite Existing Note'
                '.Cells(cel.Row, SiteMan.Column).Value = note'
            'Insert Note Before Existing Note'
                '.Cells(cel.Row, SiteMan.Column).Value = note & " " & .Cells(cel.Row, SiteMan.Column).Value'
            'Insert Note After Existing Note'
                .Cells(cel.Row, SMNCol.Column).Value = .Cells(cel.Row, SMNCol.Column).Value & " " & note
            End If
        End If
    Next cel
End With
 
Upvote 0
Not following. You have an issue with the code, or it does what you want?
bmkelly said:
Only issue I have with this is how to incorporate the "
Click to expand...

bmkelly said:
combined all my subs into one and it still ran accurately
Click to expand...
Was thinking you'd want to add a line feed and not just a space, but maybe not.
SMNCol.Column).Value & vbCrLf

Not sure if vbCrLf will work in a spreadsheet.
 
Upvote 0
Micron said:
Not following. You have an issue with the code, or it does what you want?



Was thinking you'd want to add a line feed and not just a space, but maybe not.
SMNCol.Column).Value & vbCrLf

Not sure if vbCrLf will work in a spreadsheet.
Click to expand...
It does what I want but this code is the only one that was updated by an individual on here where they were able to have the "note" add on-to any existing note already but my other subs overwrite the notes

VBA Code: 
'Blank Warranty Addition'
    Dim TTCol As Range
    Dim WECol As Range
    Dim SMNCol As Range
    Dim rng As Range
    Dim cel As Range
    Dim LR As Long
    Dim note As String
    
    note = "Review - Blank Warranty Addition"

    Application.ScreenUpdating = False

        With Sheets("Export Detail")
        
    'TheSheet.Range.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)'
        Set TTCol = .Range("1:1").Find("Transaction Type", , xlValues, xlWhole)
        Set WECol = .Range("1:1").Find("WarrantyEnd", , xlValues, xlWhole)
        Set SMNCol = .Range("1:1").Find("Site Manager Notes", , xlValues, xlWhole)

        LR = .Cells(.Rows.Count, TTCol.Column).End(xlUp).Row
    
        Set rng = .Range(.Cells(2, TTCol.Column), .Cells(LR, TTCol.Column))
            For Each cel In rng
                If cel.Value = "Addition" Then
                If .Cells(cel.Row, WECol.Column) = "" Then
            'USE ONLY ONE OF THE FOLLOWING'
            'Overwrite Existing Note'
                '.Cells(cel.Row, SiteMan.Column).Value = note'
            'Insert Note Before Existing Note'
                '.Cells(cel.Row, SiteMan.Column).Value = note & " " & .Cells(cel.Row, SiteMan.Column).Value'
            'Insert Note After Existing Note'
                .Cells(cel.Row, SMNCol.Column).Value = .Cells(cel.Row, SMNCol.Column).Value & " " & note
            End If
        End If
    Next cel
End With
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

M
  • Question
Add in VBA Code to check zip code against pre-determined list
Replies
0
Views
154
mikefisher
M
J
  • Question
Check if any values are already in the established FirstRow
Replies
9
Views
317
NoSparks
N
J
  • Solved
multiple values
Replies
2
Views
183
JOEE1979
J
B
  • Question
Find 'Missing Coverage' in Column, Then Find 'Additions' in another Column, Then Insert Comment in the same row but in Site Manager Notes Column
Replies
3
Views
452
Peter_SSs
Peter_SSs
B
  • Locked
  • Question
VBA Help! Find [insert value] in Column, Then Find [insert other value] in another Column, To then Insert a Comment in another Column
Replies
1
Views
345
Fluff
Fluff

Forum statistics

Threads
1,214,866
Messages
6,121,996
Members
449,060
Latest member
mtsheetz

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top