VBA code to read headers

[bmkelly]

Hello I currently am trying to have my code Read/Find by Column Headers instead of Columns M, O, and U that you see in my code below. I just want to make sure that it reads and finds the headera and then goes through the code that way if anyone adds any columns it doesn't effect the code any.

Sub BlankWarranty()

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

    Dim r1 As String, 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 Analyst Notes'
    Range("U2:U" & lr).Value = Evaluate("=IF(" & r1 & "=""Addition"",IF(ISBLANK(" & r2 & "),""Review - Blank Warranty Addition"",""""),"""")")

End Sub

 

[NoSparks]

Please, take the guess work out of what you're working with and post something we can actually see and work with.
Either use the forums XL2BB add in
or share an anonymized file using onedrive, google drive, drop box or box.com (which is free for individual use) or some other file sharing site. Thanks.

 

[bmkelly]

Please, take the guess work out of what you're working with and post something we can actually see and work with.
Either use the forums XL2BB add in
or share an anonymized file using onedrive, google drive, drop box or box.com (which is free for individual use) or some other file sharing site. Thanks.

My apologies for the delay

Here is an XL2BB Screenshot of example data I am working with:

Test Pricing Doc.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U
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
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 Device
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 - High Dollar Device
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 Device
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 Device
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 Device
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	$ 5,000.00		Review - Missing Coverage
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
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
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
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		Review - Missing Coverage
12	000000912345678	23456	ACCT1234567	abcdefghijklmnopqrstuvwxyz	ABC Hospital	K Department	912345678	K-12345	K Manu	K Model	Test	All Parts & Labor	Addition	8/6/2021				8/6/2021	$ 2,400.00		Review - Blank Warranty Addition
Export Detail

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
A1:A195	Cell Value	duplicates	text	NO

I would like for the code to read Headers in Row 1 and Find 'Transaction Type' in Column M. Then Find 'Addition' in the Transaction Type Colum, then find 'WarrantyEnd' Column in Column O and if the data is blank then I would like for the code to insert a note in the 'Site Manager Notes' Column stating "Review - Blank Warranty Addition".

 

[NoSparks]

then I would like for the code to insert a note in the 'Site Manager Notes' Column stating "Review - Blank Warranty Addition".

Is that to overwrite existing note
or be ahead of or after what already exists ?

 

[NoSparks]

Sorry, I had interpreted your original post as both Addition and the note to have the double quote marks around them.

Sub Testing_v2()

    Dim Trans As Range     'Transaction Type -> M equiv
    Dim WarEnd As Range    'WarrantyEnd -> O equiv
    Dim SiteMan As Range   'Site Manager Notes -> U equiv
    Dim rng As Range, cel As Range
    Dim LR As Long, note As String
    
note = "Review - Blank Warranty Addition"
Application.ScreenUpdating = False
With Sheets("Sheet1")       '<~~~~~ use your actual sheet name
' TheSheet.Range.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
    Set Trans = .Range("1:1").Find("Transaction Type", , xlValues, xlWhole)
    Set WarEnd = .Range("1:1").Find("WarrantyEnd", , xlValues, xlWhole)
    Set SiteMan = .Range("1:1").Find("Site Manager Notes", , xlValues, xlWhole)

    LR = .Cells(.Rows.Count, Trans.Column).End(xlUp).Row
    
    Set rng = .Range(.Cells(2, Trans.Column), .Cells(LR, Trans.Column))
    For Each cel In rng
        If cel.Value = "Addition" Then
            If .Cells(cel.Row, WarEnd.Column) = "" Then
            ' USE ONLY ONE OF THE FOLLOWING
            ' to over write
                '.Cells(cel.Row, SiteMan.Column).Value = note
            ' to insert ahead of existing
                .Cells(cel.Row, SiteMan.Column).Value = note & " " & .Cells(cel.Row, SiteMan.Column).Value
            ' to insert after existing
                '.Cells(cel.Row, SiteMan.Column).Value = .Cells(cel.Row, SiteMan.Column).Value & " " & note
            End If
        End If
    Next cel
End With
Application.ScreenUpdating = True
End Sub

 

[bmkelly]

Is that to overwrite existing note
or be ahead of or after what already exists ?

It unfortunately does overwrite the existing note but ideally I would love to have a code that would add onto the Note if there is already one existing

Update - sorry I see in your code how you have choose one of the following! I will give that a shot and keep you updated on end result!

 

[bmkelly]

Sorry, I had interpreted your original post as both Addition and the note to have the double quote marks around them.

Sub Testing_v2()

    Dim Trans As Range     'Transaction Type -> M equiv
    Dim WarEnd As Range    'WarrantyEnd -> O equiv
    Dim SiteMan As Range   'Site Manager Notes -> U equiv
    Dim rng As Range, cel As Range
    Dim LR As Long, note As String
   
note = "Review - Blank Warranty Addition"
Application.ScreenUpdating = False
With Sheets("Sheet1")       '<~~~~~ use your actual sheet name
' TheSheet.Range.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
    Set Trans = .Range("1:1").Find("Transaction Type", , xlValues, xlWhole)
    Set WarEnd = .Range("1:1").Find("WarrantyEnd", , xlValues, xlWhole)
    Set SiteMan = .Range("1:1").Find("Site Manager Notes", , xlValues, xlWhole)

    LR = .Cells(.Rows.Count, Trans.Column).End(xlUp).Row
   
    Set rng = .Range(.Cells(2, Trans.Column), .Cells(LR, Trans.Column))
    For Each cel In rng
        If cel.Value = "Addition" Then
            If .Cells(cel.Row, WarEnd.Column) = "" Then
            ' USE ONLY ONE OF THE FOLLOWING
            ' to over write
                '.Cells(cel.Row, SiteMan.Column).Value = note
            ' to insert ahead of existing
                .Cells(cel.Row, SiteMan.Column).Value = note & " " & .Cells(cel.Row, SiteMan.Column).Value
            ' to insert after existing
                '.Cells(cel.Row, SiteMan.Column).Value = .Cells(cel.Row, SiteMan.Column).Value & " " & note
            End If
        End If
    Next cel
End With
Application.ScreenUpdating = True
End Sub

It worked! Now I just need to figure out how to incorporate this code from you:

            ' to insert after existing
                '.Cells(cel.Row, SiteMan.Column).Value = .Cells(cel.Row, SiteMan.Column).Value & " " & note

into the rest of my other subs to add notes onto it!
Thank you!

 

[bmkelly]

Sorry, I had interpreted your original post as both Addition and the note to have the double quote marks around them.

Sub Testing_v2()

    Dim Trans As Range     'Transaction Type -> M equiv
    Dim WarEnd As Range    'WarrantyEnd -> O equiv
    Dim SiteMan As Range   'Site Manager Notes -> U equiv
    Dim rng As Range, cel As Range
    Dim LR As Long, note As String
   
note = "Review - Blank Warranty Addition"
Application.ScreenUpdating = False
With Sheets("Sheet1")       '<~~~~~ use your actual sheet name
' TheSheet.Range.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
    Set Trans = .Range("1:1").Find("Transaction Type", , xlValues, xlWhole)
    Set WarEnd = .Range("1:1").Find("WarrantyEnd", , xlValues, xlWhole)
    Set SiteMan = .Range("1:1").Find("Site Manager Notes", , xlValues, xlWhole)

    LR = .Cells(.Rows.Count, Trans.Column).End(xlUp).Row
   
    Set rng = .Range(.Cells(2, Trans.Column), .Cells(LR, Trans.Column))
    For Each cel In rng
        If cel.Value = "Addition" Then
            If .Cells(cel.Row, WarEnd.Column) = "" Then
            ' USE ONLY ONE OF THE FOLLOWING
            ' to over write
                '.Cells(cel.Row, SiteMan.Column).Value = note
            ' to insert ahead of existing
                .Cells(cel.Row, SiteMan.Column).Value = note & " " & .Cells(cel.Row, SiteMan.Column).Value
            ' to insert after existing
                '.Cells(cel.Row, SiteMan.Column).Value = .Cells(cel.Row, SiteMan.Column).Value & " " & note
            End If
        End If
    Next cel
End With
Application.ScreenUpdating = True
End Sub

Do you think if I showed you my other code, how to incorporate "'.Cells(cel.Row, SiteMan.Column).Value = .Cells(cel.Row, SiteMan.Column).Value & " " & note" this to those Subs as well? Essentially, I have a number of Subs that will look for specific criteria and then add a note in the Site Manager Notes Column but if there is an existing note already there, I would love for the code to add on to the existing note instead of overwriting which it currently does.

 

[NoSparks]

if you need to go ahead and I'll have a look

 

[bmkelly]

if you need to go ahead and I'll have a look

No worries if its too crazy or whatever just was wondering the thought process on how to add a specific note to an existing note, below is my code I currently have

'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

Application.ScreenUpdating = True

'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 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

'Proration'
    Dim PCol As Range
    Dim ACol As Range

        On Error Resume Next
    
        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?"
            
        If PCol Is Nothing Then Exit Sub
 
    End With
    
'High Dollar Value'
    Dim BCol As Range

        On Error Resume Next

        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

'Low Dollar Value'
    Dim BDSCol As Range

        On Error Resume Next

        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
    
'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 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

'Under Contract'
    Dim VCol As Range
 
        On Error Resume Next

        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

 

[NoSparks]

Based on post 12, you don't have a column with the header "Notes", should that be something else ?