Split & Manipulate large file then save all worksheets as html

[iddy]

Hi

I have an excel file (575776 rows) that consists of data I need to save as individual html tables (so i can use for .shtml webpages).

This exercise will need to be repeated so I'm hoping to gather macros to do this. I've found some macros but am still missing others (listed below)

By my calculations there will be 20644 sheets so I'd appreciate if someone could also review the macros I've listed below and maybe change them to suit excel 2010 on windows 7 (32bit 2.00 GB memory installed) as I'm assuming my pc spec would struggle with it. Or obviously if someone has another way to do this I'd welcome it

The data sheet has headers in row 1 but basically the steps I can see are as follows

01. split into multiple worksheets based on category in column B (macro below)
02. Rename the new worksheets based on value in cell A2 of each new worksheet (macro below)
03. Copy headers from original data sheet to each of the new sheets
04. Insert new row in each new worksheet (so headers move from row 1 to row 2)
05. Copy text from cell b3 to c1 (all new worksheets)
06. Delete columns A & B (all new worksheets)
07. Centre text copied in step 05 across all columns (ideally format so it looks like a header for the table - black fill, white bold text)(all new worksheets)
08. Save each worksheet as html (using worksheet name)

The "save as webpage" option in Excel give a file thats too big for my purposes. The bare code for the tables (including border and formatted header)is really all I need.

Any help, macros etc appreciated.

Thanks






split into multiple worksheets based on category in column B

Option Explicit

Sub SplitIntoWorksheets()
'Declare variables
Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet, wSheetStart As Worksheet
Dim strTitle As String, fCol As Long

'Speed up execution
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

'Set activesheet to a variable name so we can refer to it easily
    Set wSheetStart = ActiveSheet

'Turn off the Autofilter in case it got left on accidentally
    wSheetStart.AutoFilterMode = False

'Enter the column # here to evaluate, column A = 1
    fCol = 2       
  
'Set a range out the values in the chosen column
    Set rRange = Range(Cells(1, fCol), Cells(Rows.Count, fCol).End(xlUp))
 
'Check if "UniqueList" sheet exists
    If Not Evaluate("ISREF(UniqueList!A1)") Then
        Worksheets.Add().Name = "UniqueList"        'add it if needed
    Else
        Worksheets("UniqueList").Cells.Clear        'clear it if it exists already
    End If
    
'Filter the Set rRange so unique item list is created
    With Worksheets("UniqueList")
        rRange.AdvancedFilter xlFilterCopy, , Worksheets("UniqueList").Range("A1"), True

'Set the rRange variable to the unique list of values, without the heading
        Set rRange = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    End With

'Starting with the original data sheet again...
    With wSheetStart
    '...Evaluate the rRange items against the data sheet one unique value at a time
        For Each rCell In rRange
        'create a version of the value with no spaces in it so it can be used as sheetname
            strTitle = Left(Replace(rCell, " ", "_"), 31)
        'Filter the original data by the field:=fCol and the criteria1:=rcell
            .Range("A1").AutoFilter fCol, rCell
        
        'Test to see if a sheet already exists for this value
            If Not Evaluate("ISREF('" & strTitle & "'!A1)") Then
                Worksheets.Add().Name = strTitle     'add it if needed
            Else
                Worksheets(strTitle).Cells.Clear     'clear it if it exists
            End If
    
        'Copy filtered data (visible data only) to the new/cleared sheet    
            .UsedRange.Copy Destination:=Worksheets(strTitle).Range("A1")

        'Clean up the new sheet's appearance
            Worksheets(strTitle).Cells.Columns.AutoFit

        'Loop around to the next unique value
        Next rCell

    'When all values are processed, turn off the Autofilter in the data
        .AutoFilterMode = False

    'Return to the data sheet
        .Activate
    End With

'reactivate application settings turned off earlier for speed
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Rename the new worksheets based on value in cell A2

Sub RenameSheets()
    Dim x                As Integer
    With Worksheets
        For x = 1 To .Count
            .Item(x).Name = .Item(x).Range("A2").Value2
        Next x
    End With
End Sub