PDA

View Full Version : Solved: create html code from parsed xml data on worksheet



mperrah
05-14-2012, 03:34 PM
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
05-14-2012, 03:55 PM
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
05-14-2012, 04:24 PM
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
05-15-2012, 11:53 AM
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
05-24-2012, 09:59 AM
xld is helping me on this in a separate post
http://www.vbaexpress.com/forum/showthread.php?t=42284