Hello, I am trying to have my notes add to existing notes instead of overwriting what is already there (whether the notes are manually typed in or from the macro). Below is what I am looking for in regards to each note to be added. An individual helped me with the "Blank Warranty Addition" Note where it adds on to existing notes but I would like to incorporate that into the others.
Here is my Macro
'Blank Warranty Addition'
need to look down the 'Transaction Type' column, finding the word 'Addition', look to see if the 'WarrantyEnd' cell on that row is blank and if it is, add the note to the 'Site Manager Notes' cell.
'Reactivations'
need to look down the 'Notes' column, find the words Standard Reactivations and then add the note "Reactivation" to the 'Site Manager Notes' cell.
'Proration'
need to look down the 'Proration Date' column, if there is a date in this column then add the note "Review - Prorate?" to the 'Site Manager Notes' cell.
'High Dollar Value'
need to look down the 'BDS Unite Price' column, if the value is above $4,999.00 then add the note "Review - High Dollar Value" to the 'Site Manager Notes' cell.
'Low Dollar Value'
need to look down the 'BDS Unite Price' column, if the value is below -$4,999.00 then add the note "Review - Low Dollar Value" to the 'Site Manager Notes' cell.
'Missing Coverage'
need to look down the 'Coverage' column, find the words "Missing Coverage" and then add the note "Review - Missing Coverage" to the 'Site Manager Notes' cell.
'Under Contract'
need to look down the 'Vendor Contract' column, if there is data in this column then add the note "Review - Contract" to the 'Site Manager Notes' cell.
I feel like most of these would be written a similar fashion, that way when I have or add more automation then I can just take the code and change a few pieces of criteria to match - example: I would like to do something where the code will look down the "Transaction Type" column for "Transfer" and then look down the "Coverage" column for "Missing Coverage or the "Warranty End" column with a blank warranty (blank cell) or the "Vendor Contract" column and if it has a contract then leave the "Site Manager Notes" cell 'Blank'. That is another add on I would like to incorporate but for your sake and sanity we can just focus on the above.
Here is example data of the entire headers of the worksheet:
Here is my Macro
VBA Code:
Sub MyPricing()
Application.ScreenUpdating = False
'Insert Analyst Notes, Site Manager Notes and Corrections Column'
Dim rngUsernameHeader As Range
Dim rngHeaders As Range
Set rngHeaders = Range("1:1")
Set rngUsernameHeader = rngHeaders.Find(What:="BDS Unit Price", After:=Cells(1, 1))
rngUsernameHeader.Offset(0, 1).EntireColumn.Insert
rngUsernameHeader.Offset(0, 1).Value = "Analyst Notes"
Set rngHeaders = Range("1:1")
Set rngUsernameHeader = rngHeaders.Find(What:="Analyst Notes", After:=Cells(1, 1))
rngUsernameHeader.Offset(0, 1).EntireColumn.Insert
rngUsernameHeader.Offset(0, 1).Value = "Site Manager Notes"
Set rngHeaders = Range("1:1")
Set rngUsernameHeader = rngHeaders.Find(What:="Site Manager Notes", After:=Cells(1, 1))
rngUsernameHeader.Offset(0, 1).EntireColumn.Insert
rngUsernameHeader.Offset(0, 1).Value = "Corrections"
'Highlighting Columns'
Range("Table1[[#Headers],[Analyst Notes]:[Corrections]]").Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
'Format Date'
hdrs = Array("EnteredDate", "WarrantyEnd", "RetiredDate", "Proration Date", "Charged Date", "InstalledDate", "VendorContractEnd")
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
heads = Range(Cells(1, 1), Cells(1, LastCol))
For i = 0 To UBound(hdrs)
For j = 1 To UBound(heads, 2)
If hdrs(i) = heads(1, j) Then
Range(Cells(1, j), Cells(LastRow, j)).NumberFormat = "m/d/yyyy"
Exit For
End If
Next j
Next i
'Format Accounting'
hdrs = Array("BDS Unit Price", "SVC", "Hospital Price", "FRP", "Net_CC_Price", "Eq_Row", "True annual price", "Proration Amount", "Effective Price")
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
heads = Range(Cells(1, 1), Cells(1, LastCol))
For i = 0 To UBound(hdrs)
For j = 1 To UBound(heads, 2)
If hdrs(i) = heads(1, j) Then
Range(Cells(1, j), Cells(LastRow, j)).Style = "Currency"
Exit For
End If
Next j
Next i
'Format Width'
Cells.ColumnWidth = 15
Range("Table1[[#Headers],[EquipmentID]]").Select
'Reactivations'
Dim NCol As Range
On Error Resume Next
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 ANCol = Range("1:1").Find("Analyst Notes", , , xlWhole, , , False, , False)
If ANCol Is Nothing Then
MsgBox "Analyst 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(, ANCol.Column - .Column).Value = "Reactivation"
On Error GoTo 0
.Replace "=true", "Standard Reactivations", xlWhole, , False, , False, False
End With
'Proration'
Dim PCol As Range
On Error Resume Next
Set PCol = Range("1:1").Find("Proration Date", , , xlWhole, , , False, , False)
If PCol Is Nothing Then
MsgBox "Proration Date Column Not Found"
Exit Sub
End If
Set ANCol = Range("1:1").Find("Analyst Notes", , , xlWhole, , , False, , False)
If ANCol Is Nothing Then
MsgBox "Analyst Notes Column Not Found"
Exit Sub
End If
With Range(PCol.Offset(1), Cells(Rows.Count, PCol.Column).End(xlUp))
.SpecialCells(xlConstants).Offset(, ANCol.Column - PCol.Column).Value = "Review - Prorate?"
If PCol Is Nothing Then Exit Sub
End With
'High Dollar Value'
Dim BDSCol As Range
On Error Resume Next
Set BDSCol = Range("1:1").Find("BDS Unit Price", , , xlWhole, , , False, , False)
If BDSCol Is Nothing Or ANCol Is Nothing Then
MsgBox "BDS Unit Price Column Not Found"
Exit Sub
End If
Set ANCol = Range("1:1").Find("Analyst Notes", , , xlWhole, , , False, , False)
If ANCol Is Nothing Then
MsgBox "Analyst Notes Column Not Found"
Exit Sub
End If
With Range(BDSCol.Offset(1), Cells(Rows.Count, BDSCol.Column).End(xlUp)).Offset(, ANCol.Column - BDSCol.Column)
.Value = Evaluate(Replace(Replace("if(#>4999,""Review - High Dollar Device"",if(@="""","""",@))", "@", .Address), "#", .Offset(, BDSCol.Column - ANCol.Column).Address))
End With
'Low Dollar Value'
On Error Resume Next
Set BDSCol = Range("1:1").Find("BDS Unit Price", , , xlWhole, , , False, , False)
If BDSCol Is Nothing Or ANCol Is Nothing Then
MsgBox "BDS Unit Price Column Not Found"
Exit Sub
End If
Set ANCol = Range("1:1").Find("Analyst Notes", , , xlWhole, , , False, , False)
If ANCol Is Nothing Then
MsgBox "Analyst Notes 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
'Missing Coverage'
Dim CCol As Range
On Error Resume Next
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 ANCol = Range("1:1").Find("Analyst Notes", , , xlWhole, , , False, , False)
If ANCol Is Nothing Then
MsgBox "Analyst 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(, ANCol.Column - .Column).Value = "Review - Missing Coverage"
On Error GoTo 0
.Replace "=true", "Missing Coverage", xlWhole, , False, , False, False
End With
'Under Contract'
Dim VCol As Range
On Error Resume Next
Set VCol = Range("1:1").Find("VendorContract", , , xlWhole, , , False, , False)
If VCol Is Nothing Then
MsgBox "VendorContract Column Not Found"
Exit Sub
End If
Set ANCol = Range("1:1").Find("Analyst Notes", , , xlWhole, , , False, , False)
If ANCol Is Nothing Then
MsgBox "Analyst Notes Column Not Found"
Exit Sub
End If
With Range(VCol.Offset(1), Cells(Rows.Count, VCol.Column).End(xlUp))
.SpecialCells(xlConstants).Offset(, ANCol.Column - VCol.Column).Value = "Review - Contract"
End With
'Blank Warranty Addition'
Dim TTCol As Range
Dim WECol As Range
Dim rng As Range
Dim cel As Range
Dim LR As Long
Dim note As String
note = "Review - Blank Warranty Addition"
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 ANCol = .Range("1:1").Find("Analyst 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
'Insert Note After Existing Note'
.Cells(cel.Row, ANCol.Column).Value = .Cells(cel.Row, ANCol.Column).Value & " " & note
End If
End If
Next cel
End With
'Hiding Columns'
Dim LastColumn As Long
LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To LastColumn
If Cells(1, i).Value = "SVC" Or Cells(1, i).Value = "Modality" Or Cells(1, i).Value = "EQStatus" Or Cells(1, i).Value = "Sub Status" Or Cells(1, i).Value = "InstalledDate" Or Cells(1, i).Value = "Ownership" Or Cells(1, i).Value = "WarrantyCode" Or Cells(1, i).Value = "VendorContract" Or Cells(1, i).Value = "VendorContractEnd" Or Cells(1, i).Value = "ServiceStrategyYear1" Or Cells(1, i).Value = "Pricing Method" Or Cells(1, i).Value = "Notes" Or Cells(1, i).Value = "Price_Type" Or Cells(1, i).Value = "Cust_Type" Or Cells(1, i).Value = "Net_CC_Price" Or Cells(1, i).Value = "Eq_Row" Or Cells(1, i).Value = "True annual price" Or Cells(1, i).Value = "Proration Amount" Then Columns(i).Hidden = True
Next
'Highlighting Columns'
Range("Table1[[#Headers],[Analyst Notes]:[Corrections]]").Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
'Hide Exceptions'
Worksheets("Exceptions").Visible = False
'Select Cell A1'
Range("Table1[[#Headers],[EquipmentID]]").Select
Application.ScreenUpdating = True
End Sub'Blank Warranty Addition'
need to look down the 'Transaction Type' column, finding the word 'Addition', look to see if the 'WarrantyEnd' cell on that row is blank and if it is, add the note to the 'Site Manager Notes' cell.
'Reactivations'
need to look down the 'Notes' column, find the words Standard Reactivations and then add the note "Reactivation" to the 'Site Manager Notes' cell.
'Proration'
need to look down the 'Proration Date' column, if there is a date in this column then add the note "Review - Prorate?" to the 'Site Manager Notes' cell.
'High Dollar Value'
need to look down the 'BDS Unite Price' column, if the value is above $4,999.00 then add the note "Review - High Dollar Value" to the 'Site Manager Notes' cell.
'Low Dollar Value'
need to look down the 'BDS Unite Price' column, if the value is below -$4,999.00 then add the note "Review - Low Dollar Value" to the 'Site Manager Notes' cell.
'Missing Coverage'
need to look down the 'Coverage' column, find the words "Missing Coverage" and then add the note "Review - Missing Coverage" to the 'Site Manager Notes' cell.
'Under Contract'
need to look down the 'Vendor Contract' column, if there is data in this column then add the note "Review - Contract" to the 'Site Manager Notes' cell.
I feel like most of these would be written a similar fashion, that way when I have or add more automation then I can just take the code and change a few pieces of criteria to match - example: I would like to do something where the code will look down the "Transaction Type" column for "Transfer" and then look down the "Coverage" column for "Missing Coverage or the "Warranty End" column with a blank warranty (blank cell) or the "Vendor Contract" column and if it has a contract then leave the "Site Manager Notes" cell 'Blank'. That is another add on I would like to incorporate but for your sake and sanity we can just focus on the above.
Here is example data of the entire headers of the worksheet:
| Test Pricing Doc - Example Data.xlsx | ||||||||||||||||||||||||||||||||||||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z | AA | AB | AC | AD | AE | AF | AG | AH | AI | AJ | AK | AL | AM | AN | AO | AP | AQ | AR | |||
| 1 | EquipmentID | Model_ID | RSQM_CustNmbr | DepartmentID | RSQM_Cust_Name | Department | CEID | Serial | Manufacturer | Model | Description | Coverage | Transaction Type | EnteredDate | WarrantyEnd | RetiredDate | Proration Date | Charged Date | BDS Unit Price | Analyst Notes | Site Manager Notes | Corrections | SVC | Modality | EQStatus | Sub Status | InstalledDate | Ownership | WarrantyCode | VendorContract | VendorContractEnd | QTR Eff | ServiceStrategyYear1 | Pricing Method | Notes | Hospital Price | FRP | Price_Type | Cust_Type | Net_CC_Price | Eq_Row | True annual price | Proration Amount | OY22 Impact | ||
| 2 | 000000012345678 | 1234 | ACCT1234567 | abcdefghijklmnopqrstuvwxyz | ABC Hospital | A Department | 12345678 | A-12345 | A Manu | A Model | Test | All Parts & Labor | Coverage Change | 10/22/2018 | 8/20/2021 | $ 32,750.00 | Review - High Dollar Value | $ 755,509.11 | RADIOLOGY | Active | Owned | 8/18/2018 | OY22-Qtr1 | InHouse-Full Service | Coverage Change Delta | Standard Coverage Change | $ 48,250.00 | $ 81,000.00 | FRP | Oct - Sept | $ 81,000.00 | $ - | $ 28,173.97 | |||||||||||||
| 3 | 000000023456789 | 2345 | ACCT1234567 | abcdefghijklmnopqrstuvwxyz | ABC Hospital | B Department | 23456789 | B-12345 | B Manu | B Model | Test | All Parts & Labor | Coverage Change | 12/27/2019 | 12/1/2020 | 12/1/2020 | 7/1/2021 | $ 19,250.00 | Review - Prorate? - Review - High Dollar Value | Standard Coverage Change | $ 11,180.82 | $ 30,378.08 | ||||||||||||||||||||||||
| 4 | 000000034567891 | 3456 | ACCT1234567 | abcdefghijklmnopqrstuvwxyz | ABC Hospital | C Department | 34567891 | C-12345 | C Manu | C Model | Test | All Parts & Labor | Addition | 9/1/2021 | 9/1/2021 | $ 6,900.00 | Review - High Dollar Value - Review - Blank Warranty Addition | $ 58,602.11 | RADIOLOGY | Active | Owned | 8/31/2021 | OY22-Qtr1 | InHouse-Full Service | OY Budget Model Price | Standard Additions | $ 6,900.00 | FRP | Oct - Sept | $ - | $ 5,709.04 | |||||||||||||||
| 5 | 000000045678912 | 4567 | ACCT1234567 | abcdefghijklmnopqrstuvwxyz | ABC Hospital | D Department | 45678912 | D-12345 | D Manu | D Model | Test | All Parts & Labor | Addition | 9/7/2021 | 9/7/2021 | 9/7/2021 | $ 6,500.00 | Review - High Dollar Value | $ 11,308.18 | BIOMED | Active | Owned | 9/7/2021 | OY22-Qtr1 | InHouse-Full Service | Prime Price | Standard Additions | $ 6,500.00 | FRP | Oct - Sept | $ - | $ 5,271.23 | ||||||||||||||
| 6 | 000000056789123 | 5678 | ACCT1234567 | abcdefghijklmnopqrstuvwxyz | ABC Hospital | E Department | 56789123 | E-12345 | E Manu | E Model | Test | All Parts & Labor | Coverage Change | 10/22/2018 | 7/8/2021 | $ 5,940.80 | Review - High Dollar Value | $ 31,494.11 | BIOMED | Active | Owned | 11/19/2015 | OY22-Qtr1 | InHouse-Full Service | Coverage Change Delta | Standard Coverage Change | $ 2,059.20 | $ 8,000.00 | FRP | Oct - Sept | $ 8,000.00 | $ - | $ 5,810.59 | |||||||||||||
| 7 | 000000067891234 | 6789 | ACCT1234567 | abcdefghijklmnopqrstuvwxyz | ABC Hospital | F Department | 67891234 | F-12345 | F Manu | F Model | Test | Missing Coverage | Addition | 8/17/2021 | 8/17/2021 | $ 4,998.00 | Review - Missing Coverage - Review - Blank Warranty Addition | $ 26,715.18 | RADIOLOGY | Active | Owned | 8/17/2021 | OY22-Qtr1 | InHouse-Full Service | Market Price | Standard Additions | $ 5,000.00 | FRP | Oct - Sept | $ - | $ 4,342.47 | |||||||||||||||
| 8 | 000000567891234 | 7891 | ACCT1234567 | abcdefghijklmnopqrstuvwxyz | ABC Hospital | G Department | 567891234 | G-12345 | G Manu | G Model | Test | Missing Coverage | Coverage Change | 10/22/2018 | 9/20/2021 | $ 4,960.00 | Review - Missing Coverage - Review - Contract | $ 328,400.18 | RADIOLOGY | Active | Owned | 1/6/2013 | TVC010919 | OY22-Qtr1 | InHouse-Full Service | Coverage Change Delta | Standard Coverage Change | $ 39,040.00 | $ 44,000.00 | FRP | Oct - Sept | $ 44,000.00 | $ - | $ 3,845.70 | ||||||||||||
| 9 | 000000678912345 | 8912 | ACCT1234567 | abcdefghijklmnopqrstuvwxyz | ABC Hospital | H Department | 678912345 | H-12345 | H Manu | H Model | Test | Missing Coverage | Coverage Change | 9/11/2019 | 1/1/2018 | 9/20/2021 | $ 4,600.00 | Review - Missing Coverage | $ 44,875.11 | RADIOLOGY | Active | Owned | 10/4/2017 | OY22-Qtr1 | InHouse-Full Service | Coverage Change Delta | Standard Coverage Change | $ - | $ 4,600.00 | FRP | Oct - Sept | $ 4,600.00 | $ - | $ 3,566.58 | ||||||||||||
| 10 | 000000789123456 | 9123 | ACCT1234567 | abcdefghijklmnopqrstuvwxyz | ABC Hospital | I Department | 789123456 | I-12345 | I Manu | I Model | Test | Missing Coverage | Coverage Change | 9/13/2019 | 9/1/2018 | 9/20/2021 | $ 4,300.00 | Review - Missing Coverage | $ 168,317.11 | RADIOLOGY | Active | Owned | 9/12/2019 | OY22-Qtr1 | InHouse-Full Service | Coverage Change Delta | Standard Coverage Change | $ - | $ 4,300.00 | FRP | Oct - Sept | $ 4,300.00 | $ - | $ 3,333.97 | ||||||||||||
| 11 | 000000891234567 | 12345 | ACCT1234567 | abcdefghijklmnopqrstuvwxyz | ABC Hospital | J Department | 891234567 | J-12345 | J Manu | J Model | Test | Missing Coverage | Addition | 8/6/2021 | 8/6/2021 | $ 2,400.00 | Reactivation - Review - Blank Warranty Addition | $ 6,469.11 | BIOMED | Active | Owned | 8/6/2021 | OY22-Qtr1 | InHouse-Full Service | Prime Price Desc | Standard Reactivations | $ 2,400.00 | FRP | Oct - Sept | $ - | $ 2,156.71 | |||||||||||||||
| 12 | 000000912345678 | 23456 | ACCT1234567 | abcdefghijklmnopqrstuvwxyz | ABC Hospital | K Department | 912345678 | K-12345 | K Manu | K Model | Test | All Parts & Labor | Retirement | 8/6/2021 | 8/6/2021 | $ (5,555.00) | Review - Low Dollar Value | $ 6,469.11 | BIOMED | Active | Owned | 8/6/2021 | OY22-Qtr1 | InHouse-Full Service | Prime Price Desc | Standard Retirements | $ 2,400.00 | FRP | Oct - Sept | $ - | $ 2,156.71 | |||||||||||||||
Export Detail | ||||||||||||||||||||||||||||||||||||||||||||||
| Cell Formulas | ||
|---|---|---|
| Range | Formula | |
| AQ2:AQ12 | AQ2 | =IF([@[Proration Date]]>0,(("6/30/22"-[@[Proration Date]])*([@[BDS Unit Price]]/365))-("6/30/22"-[@[Charged Date]])*([@[BDS Unit Price]]/365),0) |
| AR2:AR12 | AR2 | =("6/30/22"-[@[Charged Date]])*([@[BDS Unit Price]]/365)+[@[Proration Amount]] |
| Cells with Conditional Formatting | ||||
|---|---|---|---|---|
| Cell | Condition | Cell Format | Stop If True | |
| A1:A195 | Cell Value | duplicates | text | NO |
