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
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