Macro to select cells and save as html

HI guys,
I am hoping that some one can help me with this. Have been looking everywhere and cant seem to get the right answer.

Here is what I have:

Sheet1 has several rows of data then one empty row. Then I have several rows of data and an empty row. This continues for about 100-150 times (this varies each week)

Here is what I am trying to do.

I need the macro to be able to select from A1 to the last row:column that has data so that I can apply borders (keep in mind that last row:column will always not be the same cell since number of rows varies).

Then I would like to save the selection as html file and file name should be whatever value I have on a1 (so if I have Jan012011 in A1, it needs to be Jan012011.htm)

I would greatly appreciate if anyone could help me with that. I have found couple of vbscript to select the cells, however because I have empty rows, those only selects first set of rows. I need the script to go all the way to the last cell that has any data.

Thanks for your help

Hello itmanusa,

Welcome to the Forum and Merry Christmas!

This macro will create a HTML file for the range in column "A" and name the file using the contents of cell "A1".

'Written: December 24, 2010
'Author:  Leith Ross
'Summary: Save the cells in column "A" staring with "A1" as an HTML file. The file is
'         saved in the currrent directory and named using the contents of cell "A1".

Sub SaveRangeAsHTML()

  Dim FileSpec As String
  Dim FSO As Object
  Dim HTMLCode As String
  Dim HTMLfile As Object
  Dim Rng As Range
  Dim Wks As Worksheet
  
    Set Wks = ActiveSheet
    
    Set Rng = Wks.Range("A1", Wks.Cells(Rows.Count, "A").End(xlUp))
    
      If Rng.Cells(1, 1) = "" Then Exit Sub
      FileSpec = CurDir & "\" & Rng.Cells(1, 1).Text & ".htm"
  
         'Convert the Range into HTML
          With ActiveWorkbook.PublishObjects
            .Add( _
                  SourceType:=xlSourceRange, _
                  FileName:=FileSpec, _
                  Sheet:=Wks.Name, _
                  Source:=Rng.Address, _
                  HtmlType:=xlHtmlStatic).Publish True
          End With
          
         'Read the HTML file back as a string
          Set FSO = CreateObject("Scripting.FileSystemObject")
          Set HTMLfile = FSO.OpenTextFile(FileSpec, 1, False)
              HTMLCode = HTMLfile.ReadAll
             'Left align HTML code
              HTMLCode = Replace(HTMLCode, "align=center x:publishsource=", _
                         "align=left x:publishsource=")
          HTMLfile.Close
          
End Sub

Adding the Macro

1. Copy the macro above pressing the keys CTRL+C
2. Open your workbook
3. Press the keys ALT+F11 to open the Visual Basic Editor
4. Press the keys ALT+I to activate the Insert menu
5. Press M to insert a Standard Module
6. Paste the code by pressing the keys CTRL+V
   
7. Make any custom changes to the macro if needed at this time.
8. Save the Macro by pressing the keys CTRL+S
9. Press the keys ALT+Q to exit the Editor, and return to Excel.

To Run the Macro...
To run the macro from Excel, open the workbook, and press ALT+F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Hello itmanusa,

I made some changes to the macro. It now looks at columns "A:H" and finds the last entry. The file will now be created if it doesn't exist.

'Written: December 24, 2010
'Updated: December 24, 2010 - Extended the range and added auto file creation.
'Author:  Leith Ross
'Summary: Save the cells in column "A" staring with "A1" as an HTML file. The file is
'         saved in the currrent directory and named using the contents of cell "A1".

Sub SaveRangeAsHTML()

  Dim FileSpec As String
  Dim FSO As Object
  Dim HTMLCode As String
  Dim HTMLfile As Object
  Dim Rng As Range
  Dim RngEnd As Range
  Dim Wks As Worksheet
  
    Set Wks = ActiveSheet
    
    Set Rng = Wks.Range("A1:H" & Rows.Count)
    Set RngEnd = Rng.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False)
    Set Rng = Wks.Range(Rng.Cells(1, 1), Wks.Cells(RngEnd.Row, "H"))
    
    If Rng Is Nothing Then Exit Sub
    
      If Rng.Cells(1, 1) = "" Then Exit Sub
      FileSpec = CurDir & "\" & Rng.Cells(1, 1).Text & ".htm"
  
         'Convert the Range into HTML
          With ActiveWorkbook.PublishObjects
            .Add( _
                  SourceType:=xlSourceRange, _
                  FileName:=FileSpec, _
                  Sheet:=Wks.Name, _
                  Source:=Rng.Address, _
                  HtmlType:=xlHtmlStatic).Publish True
          End With
          
         'Read the HTML file back as a string. Create the file if needed.
          Set FSO = CreateObject("Scripting.FileSystemObject")
          Set HTMLfile = FSO.OpenTextFile(FileSpec, 1, True)
              HTMLCode = HTMLfile.ReadAll
             'Left align HTML code
              HTMLCode = Replace(HTMLCode, "align=center x:publishsource=", _
                         "align=left x:publishsource=")
          HTMLfile.Close
          
End Sub