change table top row to a different colour with html code

[peter renton]

Hi

Is there a way to make the top row of the table that is imported into the emails in this code a different colour?

I have tried to add normal html codes but these come up with a syntax error I can change the whole table colour





Free Excel\VBA Help Forum (cross post)

Private Sub Workbook_Open()

Dim rngbody As Range
Dim c As Variant
Dim ddiff As Long
Dim mdiff As Long
Dim body As String
Dim w As Worksheet
Dim j As Integer
Dim cell As Range
Dim strto As String
    
    




For Each w In Worksheets
    If w.CodeName <> "Sheet2" Then

     strto = ""
    For Each cell In w.Range("A3:k200")
        If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 6).Value) = "yes" Then
            strto = strto & cell.Value & ";"
        End If
    Next cell
    If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)
    
    
    
Application.EnableEvents = False
        '///New Code
        Set rngbody = w.Range("A2").Resize(1, 7)
        '///
        ' Set the initial email body.  We will use this to check if we have issues later.
        body = "The Following items are Due or Overdue Inspection" & ": " & Chr(9) & Chr(9) & Chr(9) & vbCrLf & vbCrLf & vbCrLf
        For Each c In w.Range("F4:F" & w.Cells(Rows.Count, 6).End(xlUp).Row)
            ' If each value in the range is a date, then do a check for months and days.
            If IsDate(c.Value) Then
                ddiff = DateDiff("d", Now(), c.Value)
                mdiff = DateDiff("m", Now(), c.Value)
                ' If greater than 1 month away, only populate the cell, do not add to the email
                ' body.  You many want to change this.
                If ddiff > 0 Then
                    c.Offset(0, 1).Value = ddiff & "  Days From Now"
                Else
                ' Else, if we have less than one month, use days as the indicator, and
                ' increment the email body.
                    If ddiff > 1 Then
                        c.Offset(0, 1).Value = ddiff & " Days From Now"
                        body = body & c.Offset(0, -4) & ": " & Chr(9) & c.Offset(0, -3) & Chr(9) & Chr(9) & Chr(9) & ddiff & " Days from now" & vbCrLf
                Else
                    If ddiff = 0 Then
                        c.Offset(0, 1).Value = "Due Today"
                        body = body & c.Offset(0, -4) & ": " & Chr(9) & c.Offset(0, -5) & ": " & Chr(9) & Chr(9) & c.Offset(0, -3) & ": " & Chr(9) & c.Offset(0, -1) & ": " & Chr(9) & " Due today" & ": " & vbCrLf
                Else
                    c.Offset(0, 1).Value = ddiff * -1 & " Days Overdue"
                    body = body & c.Offset(0, -4) & ": " & Chr(9) & c.Offset(0, -5) & ": " & Chr(9) & c.Offset(0, -3) & ": " & Chr(9) & c.Offset(0, -1) & ": " & Chr(9) & ddiff * -1 & " Days overdue" & ": " & vbCrLf
                    '///New Code
                    Set rngbody = Union(rngbody, c.Offset(0, -5).Resize(1, 7))
                    '///
                End If
                End If
                End If
            End If
        Next c
        '///New Code
        If rngbody.Rows.Count > 1 Or rngbody.Areas.Count > 1 Then
        rngbody.Copy Sheet2.Range("A1")
        '///
        sn = Sheet2.Range("A1").CurrentRegion
        c01 = "<table border=1 bgcolor=#F3E2A9 >"
        

    
    

        

        
        On Error Resume Next
For j = 1 To UBound(sn)
         c01 = c01 & "<tr><td>" & Join(Application.Index(sn, j), "</td><td>") & "</td></tr>"
Next
c01 = c01 & "</table><P></P><P></P>"

On Error GoTo 0 '//Resets the error handler to break code in the event of an error

        


        
        
       
     
        With CreateObject("Outlook.Application").CreateItem(0)
            .To = strto
            .cc = ""
            .bcc = "northsidevan@gmail.com"
            .Subject = "Northside Bradford's Overdue " & w.Name & " Safety Checks "
            .HTMLBody = "The Items In The Table Below Are Overdue Please Complete and Update Spread Sheet A.S.A.P" & c01
            .display
            
            
      
        End With
        
        Sheet2.Cells(1).CurrentRegion.Offset(1).ClearContents
    End If
    End If
    
 Next w
Application.EnableEvents = True
            
End Sub

Regards

Peter