mperrah
05-22-2012, 03:17 PM
I have data in first sheet "Data" trying to combine 3 columns of values with data from array and create a new worksheet with results. Have searched and tried to combine several concepts.
Any help is very much appreciated. I have hand coded the results off what I am working towards. But since the data values change often and Im trying to automate the process. Thanks again for all input.
Mark
Sub ConvertDataToHTMLSheet()
Dim WebWks As Worksheet
Dim SrcWks As Worksheet
Dim ws As Worksheet
Dim newSheetName As String
Dim myRng As Range
Dim myCell As Range
Dim iCtr As Long
Dim myWebHead As Variant
Dim myWebTable As Variant
Dim myWebFoot As Variant
Dim whName As Variant
Set WebWks = Worksheets("HTML")
Set SrcWks = Worksheets("Data")
With Application
.Calculate
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
whName = Array("400 Warehouse", "500 Warehouse", "Reliance Warehouse", "Shop")
myWebHead = Array("<html>", "<head>", "<title>", whName(i), "</title>", "</head>", "<body>", "<H1>", whName(i), "</H1>", "<table>")
myWebTable = Array("<tr>", "<td>", "<a href=""", Path(iCtr), """ alt=""", LinkName(iCtr), """>", LinkName(iCtr), "</a>", "</td>", "</tr>")
myWebFoot = Array("</table>", "</body>", "</html>")
With SrcWks
Set myRng = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
End With
For Each myCell In myRng.Cells
With myCell
If IsEmpty Then
ElseIf myCell.Value = "400 Warehouse" Then
Worksheets.Add().Name = "400 Warehouse"
Worksheet("400 Warehouse").Range("A1").value = myWebHead(0 to 10)
For iCtr = LBound(myRng) To UBound(myRng)
Worksheet("400 Warehouse").Range("A & (myCtr)).value = myWebTable(0 to 10)
Worksheet("400 Warehouse").Range("A & xlDown).value = myWebFoot(0 to 2)
ElseIf myCell.Value = "500 Warehouse" Then
Worksheets.Add().Name = "500 Warehouse"
Worksheet("500 Warehouse .Range("A1").value = myWebHead(0 to 10)
For iCtr = LBound(myRng) To UBound(myRng)
Worksheet("500 Warehouse.Range("A(myCtr)).value = myWebTable(0 to 10)
Worksheet("500 Warehouse.Range("A & xlDown).value = myWebFoot(0 to 2)
End With
End If
End With
Next myCell
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Any help is very much appreciated. I have hand coded the results off what I am working towards. But since the data values change often and Im trying to automate the process. Thanks again for all input.
Mark
Sub ConvertDataToHTMLSheet()
Dim WebWks As Worksheet
Dim SrcWks As Worksheet
Dim ws As Worksheet
Dim newSheetName As String
Dim myRng As Range
Dim myCell As Range
Dim iCtr As Long
Dim myWebHead As Variant
Dim myWebTable As Variant
Dim myWebFoot As Variant
Dim whName As Variant
Set WebWks = Worksheets("HTML")
Set SrcWks = Worksheets("Data")
With Application
.Calculate
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
whName = Array("400 Warehouse", "500 Warehouse", "Reliance Warehouse", "Shop")
myWebHead = Array("<html>", "<head>", "<title>", whName(i), "</title>", "</head>", "<body>", "<H1>", whName(i), "</H1>", "<table>")
myWebTable = Array("<tr>", "<td>", "<a href=""", Path(iCtr), """ alt=""", LinkName(iCtr), """>", LinkName(iCtr), "</a>", "</td>", "</tr>")
myWebFoot = Array("</table>", "</body>", "</html>")
With SrcWks
Set myRng = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
End With
For Each myCell In myRng.Cells
With myCell
If IsEmpty Then
ElseIf myCell.Value = "400 Warehouse" Then
Worksheets.Add().Name = "400 Warehouse"
Worksheet("400 Warehouse").Range("A1").value = myWebHead(0 to 10)
For iCtr = LBound(myRng) To UBound(myRng)
Worksheet("400 Warehouse").Range("A & (myCtr)).value = myWebTable(0 to 10)
Worksheet("400 Warehouse").Range("A & xlDown).value = myWebFoot(0 to 2)
ElseIf myCell.Value = "500 Warehouse" Then
Worksheets.Add().Name = "500 Warehouse"
Worksheet("500 Warehouse .Range("A1").value = myWebHead(0 to 10)
For iCtr = LBound(myRng) To UBound(myRng)
Worksheet("500 Warehouse.Range("A(myCtr)).value = myWebTable(0 to 10)
Worksheet("500 Warehouse.Range("A & xlDown).value = myWebFoot(0 to 2)
End With
End If
End With
Next myCell
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub