Modify table borders generated by HTML macro

[Skrej]

Hi all,

I have some adapted macro code that generates a html table for data entered. I'd like to modify it so that blank cells don't have borders. I'm not sure how I can clarify, since I can't seem to post the actual HTML, but here's an example of the output (slightly different look in terms of cell padding, borders, etc. but it illustrates my point.)

3/14/2013 IDPA Shoot Results
​

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Division, Class, and Rank[/TD]
[TD]Name[/TD]
[TD]Score[/TD]
[TD]PD[/TD]
[TD]NT[/TD]
[TD]PE[/TD]
[TD]FN[/TD]
[TD]FT DR[/TD]
[TD]Stage 1[/TD]
[TD]Stage 2[/TD]
[TD]Stage 3[/TD]
[TD]Stage 4[/TD]
[TD]Stage 5[/TD]
[TD]Stage 6[/TD]
[/TR]
[TR]
[TD]CDP Expert[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Jones, Some[/TD]
[TD]86.66[/TD]
[TD]19.66[/TD]
[TD]2[/TD]
[TD]2[/TD]
[TD]2[/TD]
[TD]2[/TD]
[TD]70.3(67)[/TD]
[TD]6(0)[/TD]
[TD]4(0)[/TD]
[TD]5.36(0)[/TD]
[TD]12.36(0)[/TD]
[TD]25.36(0)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Another, Guy[/TD]
[TD]161.36[/TD]
[TD]27.36[/TD]
[TD]4[/TD]
[TD]4[/TD]
[TD]4[/TD]
[TD]4[/TD]
[TD]142.36(134)[/TD]
[TD]8(0)[/TD]
[TD]8(0)[/TD]
[TD]6.36(0)[/TD]
[TD]0(0)[/TD]
[TD]0(0)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ESP Sharpshoooter[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Rahg, Inga[/TD]
[TD]49.31[/TD]
[TD]41.81[/TD]
[TD]1[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]36.06(7.5)[/TD]
[TD]0(0)[/TD]
[TD]0(0)[/TD]
[TD]2(0)[/TD]
[TD]0(0)[/TD]
[TD]0(0)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Person, One[/TD]
[TD]220.86[/TD]
[TD]53.36[/TD]
[TD]5[/TD]
[TD]5[/TD]
[TD]5[/TD]
[TD]5[/TD]
[TD]190.86(167.5)[/TD]
[TD]5(0)[/TD]
[TD]10(0)[/TD]
[TD]3(0)[/TD]
[TD]0(0)[/TD]
[TD]0(0)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Justa, Nother[/TD]
[TD]292.45[/TD]
[TD]91.45[/TD]
[TD]6[/TD]
[TD]6[/TD]
[TD]6[/TD]
[TD]6[/TD]
[TD]223.45(201)[/TD]
[TD]12(0)[/TD]
[TD]12(0)[/TD]
[TD]15(0)[/TD]
[TD]0(0)[/TD]
[TD]0(0)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SSP Master[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Dude, Steve[/TD]
[TD]108.94[/TD]
[TD]75.44[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]58.86(33.5)[/TD]
[TD]5(0)[/TD]
[TD]2(0)[/TD]
[TD]45(0)[/TD]
[TD]0(0)[/TD]
[TD]0(0)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SSP Novice[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Tom, ****[/TD]
[TD]117.85[/TD]
[TD]17.35[/TD]
[TD]3[/TD]
[TD]3[/TD]
[TD]3[/TD]
[TD]3[/TD]
[TD]102.85(100.5)[/TD]
[TD]7(0)[/TD]
[TD]6(0)[/TD]
[TD]18(0)[/TD]
[TD]0(0)[/TD]
[TD]0(0)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SSR Master[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Blanke, Spaece[/TD]
[TD]401.99[/TD]
[TD]167.49[/TD]
[TD]7[/TD]
[TD]7[/TD]
[TD]7[/TD]
[TD]7[/TD]
[TD]246.74(234.5)[/TD]
[TD]123.25(0)[/TD]
[TD]14(0)[/TD]
[TD]4(0)[/TD]
[TD]0(0)[/TD]
[TD]0(0)[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SSR Novice[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Try, Again[/TD]
[TD]319.6[/TD]
[TD]51.6[/TD]
[TD]8[/TD]
[TD]8[/TD]
[TD]8[/TD]
[TD]8[/TD]
[TD]283.25(268)[/TD]
[TD]16.35(0)[/TD]
[TD]16(0)[/TD]
[TD]13.25(0)[/TD]
[TD]0(0)[/TD]
[TD]0(0)[/TD]
[/TR]
</tbody>[/TABLE]

Ideas on how to remove borders from blank cells (so that only cells with data have borders)? Ideally, I'd like the Div/Class column to not have borders as well, but I could live with that column having borders as long as blank cells are border-less.

Here's the code generating the html. (I'll include both the html generating macro and the table writing macro which is called).

Public Sub HTML_Gen()
   'adapted and modified from original HTML printing code by Dan Hall(?)
   'Get directory and name for htm file
    DocDestination = Application.GetSaveAsFilename(InitialFileName:="IDPAmatch.htm" _
                    , FileFilter:="htm Files (*.htm), *.htm")
    If DocDestination = False Then _
       GoTo CancelButton
    MsgBox "The new htm file will open in your browser."
    
    
    'Create header--------------------------------
    Open DocDestination For Output As 1
    Print #1, "" & Chr$(13)
    Print #1, "" & Chr$(13)
        'Establish Font in all areas
        Print #1, "<style type="" text="" css""="">" & Chr$(13)
            Print #1, "<!-- " & Chr$(13)
            Print #1, "BODY, TD, TR, P, H1, H2, H3  { font-family:  arial, helvetica, sans-serif; COLOR=""#000000""; font-size: 100% }"  & Chr$(13)
            Print #1, "A { COLOR=""0000FF"" }" & Chr$(13)
            Print #1, "A:hover { Color: #8F0000}" & Chr$(13)
            Print #1, " -->" & Chr$(13)
        Print #1, "</style>" & Chr$(13)
    MyTitle = " IDPA Match Results"
    Print #1, "<title>" & MyTitle & "</title>" & Chr$(13)
    Print #1, "" & Chr$(13)
    Print #1, "" & Chr$(13)
    PGTitle = Worksheets("Roster").Range("g2").Value
    Print #1, ""
    Print #1, "[h=1]<center>"; PGTitle; " IDPA Shoot Results"; "</center>[/h]"
    Print #1, "
"
   
   'Query for tables to include (check tables produced, ask for selections) -----------------------
   
   'Aquire basic table dimension info---------------------
    Dim TblRange As Range
    Dim NumShtr As Integer
        NumShtr = Worksheets("Roster").Range("g4").Value
    Dim NumStg As Integer
        NumStg = Worksheets("Roster").Range("g3").Value
    Dim StrtLn As Integer
        'StrtLn = Worksheets("Sheet5").Range("Z8").Value
    Application.ScreenUpdating = False
   
    'Check for table desired
    'Aquire specific table dimension info
    'pass info to write_tble for table creation
    
    'Summary--------------------------------------------------------
   
        Worksheets("Print").Select
        
        Dim Final As Integer
       Final = Worksheets("Print").Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
        
            Set TblRange = Worksheets("Print").Range(Cells(5, 1), Cells(Final, NumStg + 8))
         
            
        Call Write_Tbl(TblRange, DocDestination)
   
    
    
    'Create footer
    Print #1, "" & Chr$(13)
    Close
    
    'reset actve cell
    Worksheets("Print").Select
    Worksheets("Print").Range("c3").Select
    Application.ScreenUpdating = True
    
    'open htm file in browser
    ActiveWorkbook.FollowHyperlink _
    Address:=DocDestination, _
    NewWindow:=True
    
CancelButton:
   End Sub
   
Sub Write_Tbl(TblRange, DocDestination)
    
    'adapted and modified from original HTML printing code by Dan Hall(?)
    RowStart = TblRange.Row
    ColStart = TblRange.Column
    ColCount = TblRange.Columns.Count
    RowCount = TblRange.Rows.Count
    RowEnd = RowStart + RowCount - 1
    ColEnd = ColStart + ColCount - 1
    Print #1, "<center>" &  Chr$(13)
    Print #1, "
"
    While Row < RowCount
        Row = Row + 1
        DoEvents
      
        If (Not TblRange.Rows(Row).Hidden) Then
            MV = ""
            Col = 0
            While Col < ColCount
                Col = Col + 1
                CellV = ""
                If (Not TblRange.Columns(Col).Hidden) Then
                    strTemp = TblRange.Cells(Row, Col).Text
                    For intP = 1 To Len(strTemp)
                        strCC = Mid(strTemp, intP, 1)
                        If Asc(strCC) = 10 Then strCC = "
"
                        CellV = CellV & strCC
                    Next intP
                    If CellV = "" Then CellV = "
"
                    HzA = TblRange.Cells(Row, Col).HorizontalAlignment
                    CellA = " Align=Right "
                    If HzA = -4108 Then CellA = " Align=Center "
                    If HzA = -4131 Then CellA = " Align=Left "
                    If HzA = -4152 Then CellA = " Align=Right "
                    If TblRange.Cells(Row, Col).Font.Bold Then CellV = "[B]" & CellV & "[/B]"
                    If TblRange.Cells(Row, Col).Font.Italic Then CellV = "[I]" & CellV & "[/I]"
                    If HzA = 7 Or TblRange.Cells(Row, Col).MergeCells Then
                        CellA = " Align=Left "
                        ColSpan = 0
                        SameTitle = True
                        While (TblRange.Cells(Row,  Col).HorizontalAlignment = 7 Or TblRange.Cells(Row, Col).MergeCells) And  SameTitle
                            ' The following code must be changed for versions of Excel earlier than 97
                            If Not TblRange.Columns(Col).Hidden Then ColSpan = ColSpan + 1
                            Col = Col + 1
                            If (Len(TblRange.Cells(Row, Col).Text) > 1  Or TblRange.Cells(Row, Col).MergeCells = False) Then SameTitle = False:  Col = Col - 1
                        Wend
                        CellA = CellA & " ColSpan=" & ColSpan
                    End If
                    'find cell interior color
                    CC = TblRange.Cells(Row, Col).Interior.ColorIndex
                    BGC = ""
                    If CC = 1 Then BGC = "#000000" 'black"
                    If CC = 3 Or CC = 22 Then BGC = "#FFD0D0" 'Red"
                    If CC = 4 Or CC = 35 Then BGC = "#CCFFCC"  'green"
                    If CC = 6 Or CC = 19 Then BGC = "#FFFFCC" 'yellow"
                    If CC = 8 Or CC = 41 Or CC = 34 Or CC = 20 Then BGC = "#CCFFFF" 'blue
                    If CC = 9 Then BGC = "#8A0045" 'burgandy
                    If CC = 15 Or CC = 40 Then BGC = "#C0C0C0" 'grey"
                    If CC = 39 Or CC = 24 Or CC = 39 Then BGC = "#FFCCFF"  'Purple
                    If Len(BGC) > 2 Then BGC = " bgcolor=" & Chr(34) & BGC & Chr(34)
                    
                    'find cell font color
                    FC = TblRange.Cells(Row, Col).Font.ColorIndex
                    SFC1 = ""
                    SFC2 = ""
                    If FC = 3 Then
                        SFC1 = ""
                    ElseIf FC = 2 Then
                        SFC1 = ""
                    End If
                    If Len(SFC1) > 2 Then SFC2 = ""
                    'Replace chr(13) with 

                    'TblRange.Cells(Row, Col).Replace
                    
                    MV = MV & "<td" &="" cella="" bgc=""  "="">" & SFC1 & CellV & SFC2 & ""
                End If
            Wend
            Print #1, "</td">" & MV & "" & Chr$(13)
        End If
    Wend
    Print #1, "[TABLE]
<tbody>[TR]
[/TR]
</tbody>[/TABLE]
</center>" & Chr$(13)
    Print #1, "
"
    DoEvents
End Sub

Maybe rather than modifying the html table, the simpler solution would be to have code that merges non-blank cells before generating the html?

Any assistance or suggestions on what to look at are appreciated.

 

[Skrej]

Any ideas anybody?