Solved: create html code from parsed xml data on worksheet

[mperrah]

I'm trying to automate making a webpage.
I found a vbs script to list the folders and subfolders and contents and out put as xml.
I have imported the xml file as xls data base sheet 1
I'm using column "B" as path for a href link,
Column "C" is the Link alt text and Link Name.
This code I was trying to tweak to take the data on sheet1 "MSDS" and out put to sheet4 "detail" having trouble on selecting cell source, and outputting to new sheet.
Ultimately want to take data on result and save as .html

Sub create_html_table_data()
    Dim sh_source As Worksheet
    Dim sh_dest As Worksheet
    Dim Cell As Range
Set sh_source = Worksheets("MSDS")
    Set sh_dest = Worksheets("detail")
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    End With
nextCellD = sh_dest.Range("A" & Cells.Count).End(xlUp).Cell
    NextCellS = sh_source.Range("B" & Cells.Count).End(xlUp).Cell
    For Each Cell In sh_source.Range("B:B" & NextCellS)
    If Cell.Value <> "" Then
        nextCellD = nextCellD + 1
        With sh_source
             sh_dest.Range("A" & nextCellD).FormulaR1C1 = "<tr><td><a href="""
            .Range("C" & Cell.Value).Copy
            sh_dest.Range("B" & nextCellD).PasteSpecial Paste:=xlPasteValues
            sh_dest.Range("C" & nextCellD).FormulaR1C1 = """ alt="""
            .Range("B" & Cell.Value).Copy
            sh_dest.Range("D" & nextCellD).PasteSpecial Paste:=xlPasteValues
            sh_dest.Range("E" & nextCellD).FormulaR1C1 = """ >"
            .Range("B" & Cell.Value).Copy
            sh_dest.Range("F" & nextCellD).PasteSpecial Paste:=xlPasteValues
            sh_dest.Range("G" & nextCellD).FormulaR1C1 = "</a></td></tr>"
        End With
    End If
    Next Cell
Sheets("detail").Select
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "=RC[-7]&RC[-6]&RC[-5]&RC[-4]&RC[-3]&RC[-2]&RC[-1]"
Range("H1").Select
    Selection.Copy
Range("I1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    End With
End Sub

Thanks for any help or insights
Mark

[mperrah]

here is the slightly edited original:

Sub AddToDetail_xld()
    Dim sh_source As Worksheet
    Dim sh_dest As Worksheet
    Dim Cell As Range
Set sh_source = Worksheets("MSDS")
    Set sh_dest = Worksheets("detail")
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    End With
nextRowD = sh_dest.Range("A" & Rows.Count).End(xlUp).Row
    NextRowS = sh_source.Range("B" & Rows.Count).End(xlUp).Row
    For Each Cell In sh_source.Range("A:A" & NextRowS)
    If Cell.Value <> "" Then
        nextRowD = nextRowD + 1
        With sh_source
            .Range("C" & Cell.Row).Copy
            sh_dest.Range("C" & nextRowD).PasteSpecial Paste:=xlPasteValues
            .Range("J" & Cell.Row).Copy sh_dest.Range("B" & nextRowD)
            .Range("AU" & Cell.Row).Copy
            sh_dest.Range("D" & nextRowD).PasteSpecial Paste:=xlPasteValues
           .Range("O" & Cell.Row).Copy sh_dest.Range("E" & nextRowD)
           .Range("E" & Cell.Row).Copy sh_dest.Range("F" & nextRowD)
           .Range("P" & Cell.Row).Resize(, 31).Copy sh_dest.Range("G" & nextRowD)
        End With
    End If
    Next Cell
Sheets("Summary").Select
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    End With
End Sub

[mperrah]

This a recordered macro that does the first line of code. I just need it to loop through the rest of the rows form the source sheet and do the same thing.

Sub make_web()
Sheets("detail").Select
    ActiveCell.FormulaR1C1 = "<tr><td><a href="""
    Range("B1").Select
    Sheets("MSDS").Select
    Range("C211").Select
    Selection.Copy
    Sheets("detail").Select
    ActiveSheet.Paste
    Columns("B:B").EntireColumn.AutoFit
    Columns("A:A").EntireColumn.AutoFit
    Range("C1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = """ alt="""
    Range("D1").Select
    Sheets("MSDS").Select
    Range("B211").Select
    Selection.Copy
    Sheets("detail").Select
    ActiveSheet.Paste
    Columns("D:D").EntireColumn.AutoFit
    Range("E1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = """>"
    Range("F1").Select
    Sheets("MSDS").Select
    Selection.Copy
    Sheets("detail").Select
    ActiveSheet.Paste
    Range("G1").Select
    Columns("F:F").EntireColumn.AutoFit
    Range("G1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "</a></td></tr>"
    Range("G2").Select
    Columns("G:G").ColumnWidth = 13.14
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "=RC[-8]&RC[-7]&RC[-6]&RC[-5]&RC[-4]&RC[-3]&RC[-2]"
    Range("I1").Select
    Selection.Copy
    Range("K1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("D10").Select
    ActiveWindow.LargeScroll ToRight:=1
    Columns("A:J").Select
    Range("J1").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("A2").Select
End Sub

[mperrah]

Found this to copy data and populate new sheet. header works good
looking for a script to take 3 columns and inject cell value to a 5 column table. i have commented out the parts im troubled with.
Source is one sheet "MSDS" this code scans all sheets (not necessary) Column A is location, Column B is LinkName, Column C is Path. any ideas?

Sub MoveDataToHtmlSheet()
Dim firstrow As Integer
Dim lastrow As Long
Dim dest As Worksheet
Dim sht As Worksheet
Dim destcell As Range
firstrow = 2
     'Insert new sheet as destination for data
    Set dest = Sheets.Add
    dest.Name = "html"
     'Set range for copies to go to leaving a row for a header
    Set destcell = dest.Range("A12")
With dest
                .Range("A1").FormulaR1C1 = "<HTML>"
                .Range("A2").FormulaR1C1 = "<head>"
                .Range("A3").FormulaR1C1 = "<title>"
                'A4 copy from source in Column "A"
                .Range("A5").FormulaR1C1 = "</title>"
                .Range("A6").FormulaR1C1 = "</head>"
                .Range("A7").FormulaR1C1 = "<body>"
                .Range("A8").FormulaR1C1 = "<H1>"
                'A9  copy from source sheet in Column A
                .Range("A10").FormulaR1C1 = "</H1>"
                .Range("A11").FormulaR1C1 = "<table>"
            End With
For Each sht In Sheets
        If sht.Name <> dest.Name Then
'find bottom cell in col A
            lastrow = sht.Range("A" & Rows.Count).End(xlUp).Row
             'copy data range to destcell
            sht.Rows(firstrow & ":" & lastrow).Copy Destination:=destcell
             'set new position of destcell
            Set destcell = destcell.Offset(lastrow - firstrow, 0)
' trying to make 3 columns fill 5 columns combined with html tags
                ' then concantinate and copy values to destination sheet - like this
'  dest.Range("A" & nextRowD).FormulaR1C1 = "<tr><td><a href="""
                '  .Range("C" & Cells).Copy
                '  dest.Range("B" & nextRowD).PasteSpecial Paste:=xlPasteValues
                '  dest.Range("C" & nextRowD).FormulaR1C1 = """ alt="""
                '  .Range("B" & Cells).Copy
                '  dest.Range("D" & nextRowD).PasteSpecial Paste:=xlPasteValues
                '  dest.Range("E" & nextRowD).FormulaR1C1 = """ >"
                '  .Range("B" & Cells).Copy
                '  dest.Range("F" & nextRowD).PasteSpecial Paste:=xlPasteValues
                '  dest.Range("G" & nextRowD).FormulaR1C1 = "</a></td></tr>"
End If
    Next sht
' Sheets("HTML").Select
    ' Range("H1").Select
    ' ActiveCell.FormulaR1C1 = "=RC[-7]&RC[-6]&RC[-5]&RC[-4]&RC[-3]&RC[-2]&RC[-1]"
' Range("H1").Select
    ' Selection.Copy
'Range("I1").Select
    'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        ':=False, Transpose:=False
End Sub

[mperrah]

xld is helping me on this in a separate post
http://www.vbaexpress.com/forum/showthread.php?t=42284