Code not woring - please help!!!

S

Sue

HI All:
I tried posting this yesterday, but my post seems to have disappeared,
so if this is a repeat I appologize.

I have a macro that someone else wrote and i'm trying to add to it some
formatting and summary data at the bottom after the details section,
but nothing seems to be working. To give you a background....this macro
is launched through SAP portal, when the user hits a "export to excel"
button in the portal. When the macro is launched, a new excel sheet is
created.

My code is attached to the bottom after the original code runs and
creates the excel file. I don't write VBA code so what I've written is
pretty basic, but is starting to get the job done when its run on its
own and not as part of the original code to launch and create the excel
file. The data in the file keeps changing depending on the user view of
the portal, but the sheet name stays the same in all cases.

I've attached the entire code below. Can anyone please help me!!

Sub FormatData()

' ****************************************

' ****************************************
On Error Resume Next

Window.resizeTo 0, 0
Window.moveTo -99, -99
Mousepoint = fmMousePointerHourGlass

Set ExcelApp = CreateObject("Excel.Application")
Set ExcelBook = ExcelApp.Workbooks.Add

ExcelBook.Worksheets(1).Name = "Deal Roadmap Data"
ExcelBook.Worksheets(1).Range("1:1").Font.Bold = True
ExcelBook.Worksheets(1).Range("Q:R").NumberFormat = "0"

Dim rows, cols, i, J

'Declare the array for storing data
'Note: VBScript array index staart 0, max 65536 rows in Excel
' This is the tage and dynamic code will be inserted here from CRM
application using ABAP

Dim ColumnTable(20)
ColumnTable(0) = "20"
Dim DataTable(5)
DataTable(0) = "5"
Dim aryData(5, 20)

ColumnTable(1) = "Closing date"
ColumnTable(2) = "Company"
ColumnTable(3) = "Description 2"
ColumnTable(4) = "Sales Office Name"
ColumnTable(5) = "Estimated in"
ColumnTable(6) = "Commit"
ColumnTable(7) = "*Total Commit*"
ColumnTable(8) = "Non Commit"
ColumnTable(9) = "OAF Upside"
ColumnTable(10) = "Reason"
ColumnTable(11) = "Exist. Customer"
ColumnTable(12) = "Exec.Sponsor Name"
ColumnTable(13) = "Bus.Sponsor Name"
ColumnTable(14) = "Service Partner Name"
ColumnTable(15) = "Competitor"
ColumnTable(16) = "Comments"
ColumnTable(17) = "Oppt. Owner Name"
ColumnTable(18) = "Sales Group Name"
ColumnTable(19) = "Opportunity ID"
ColumnTable(20) = "Current Phase"
DataTable(1) = "03/31/06|Preussag International Steel|WS04 DOUBLE
QUOTE|Cincinnati|0.00|450,000.00|450,000.00|0.00|0.00||||Customer
Business Sponsor|||action item 1 close plan checked
off;team;01.04.2006" + vbLf + "action item 2 close plan checked
off;all;11.04.2006" + vbLf + "action item 3 close plan checked
off;you;01.04.2006" + vbLf + "action item 5 close plan checked
off;tbd;01.03.2006" + vbLf + "action item 6 close plan checked
off;Value Engineer;21.04.2006 |William Yount|CPG -
Retail|0300003170|B|upd"
DataTable(2) = "03/31/06|C2|#9 (SUB ZU
#2)|Washington|0.00|360,000.00|360,000.00|0.00|0.00|||||||
|Frank Weiss|Healthcare|0300003343|B|upd"
DataTable(3) = "03/31/06|Preussag International Steel|TEST ACCT OWNER
E-MAIL|Consulting - Region North East|0.00|0.00|0.00|0.00|0.00|||||||
|William Yount|Consulting North East - CED1|0300003183|A|upd"
DataTable(4) = "03/31/06|Syskoplan Gesellschaft für System-1|CEL
TEST|Walldorf|0.00|0.00|0.00|0.00|0.00||X||||| |William
Yount|to be deleted|0300003758||upd"
DataTable(5) = "||||0.00|810,000.00|810,000.00|0.00|0.00|||||||
|||TOTAL||upd"
'{%INSERT_CRM_DYNAMIC%}

rows = DataTable(0)
cols = ColumnTable(0)

' Fill the column heading
For i = 1 To cols
ExcelBook.Worksheets(1).Cells(1, i).Value = ColumnTable(i)

Next

' Fill row data in array
For i = 1 To rows

Mousepoint = fmMousePointerHourGlass
DS = DataTable(i)
POS = 0

For J = 1 To cols
POS = InStr(DS, "|")
cell = Left(DS, POS - 1)
aryData(i - 1, J - 1) = cell
DS = Right(DS, Len(DS) - POS)
Next

'DS = Right(DS, Len(DS) - POS)
'aryData(i-1,cols) = DS

Next

If rows > 0 Then
' Set a range, which corresponds exactly to the array
Dim rng
Set rng = ExcelBook.Worksheets(1).Range("A2").Resize(rows, cols)

' Assign whole Array to Range
rng.Value = aryData
End If

ExcelApp.Visible = True
ExcelBook.Worksheets(1).Columns.AutoFit
ExcelBook.Worksheets(1).rows.AutoFit
ExcelBook.Worksheets(1).PageSetup.Orientation = xlLandscape
ExcelBook.Worksheets(1).PageSetup.PaperSize = xlPaperLetter
ExcelBook.Worksheets(1).PageSetup.Zoom = 55

'FROM HERE ON IS CODE THAT I WROTE AND IT DOESNT SEEM TO BE
WORKING!!!
Dim rw As Long
Dim LRow As Long

'Sort by Region
ExcelBook.Worksheets(1).Select
ExcelBook.Worksheets(1).Range("A1").Select

With ExcelBook.Worksheets(1)
Set myrows = ExcelBook.Worksheets(1).Range("A1").CurrentRegion
myrows.Sort Key1:=.Range("R1"), Order1:=xlAscending,
Header:=xlGuess
End With

'Format details section
ExcelBook.Worksheets(1).Select
ExcelBook.Worksheets(1).Range("A1").Select
ExcelBook.Worksheets(1).Range("A1").CurrentRegion.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Selection.Interior
.ColorIndex = 24
.PatternColorIndex = xlAutomatic
End With

'Format top row
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = True
End With
With Selection.Interior
.ColorIndex = 55
.Pattern = xlSolid
End With
With Selection.Font
.ColorIndex = 2
.FontStyle = "Bold"
End With
Range("A2").Select
Cells.Select
ActiveWindow.Zoom = 75
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
End With
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
Columns("B:D").Select
Selection.ColumnWidth = 21
Range("A2").Select

'insert total to the bottom/last row and add the formatting
LRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
Cells(LRow, "B").Value = "Total"
Set rng = Range(Cells(LRow, "A"), Cells(LRow, "T"))
With rng.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With rng.Interior
.ColorIndex = 55
.Pattern = xlSolid
End With
With rng.Font
.ColorIndex = 2
.FontStyle = "Bold"
End With
'Add totals to columns E - I
LRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
Cells(LRow, "E").Value = Application.Sum(Range(Cells(2, "E"),
Cells(LRow, "E")))
Cells(LRow, "F").Value = Application.Sum(Range(Cells(2, "F"),
Cells(LRow, "F")))
Cells(LRow, "G").Value = Application.Sum(Range(Cells(2, "G"),
Cells(LRow, "G")))
Cells(LRow, "H").Value = Application.Sum(Range(Cells(2, "H"),
Cells(LRow, "H")))
Cells(LRow, "I").Value = Application.Sum(Range(Cells(2, "I"),
Cells(LRow, "I")))

'Find the last row with data
If Not IsEmpty(Range("A" & rows.Count)) Then
rw = rows.Count
Else
rw = Cells(rows.Count, "A").End(xlUp).Row
End If

'Formatting the summary section
Range("b2").Select
myrows = Range("A1").CurrentRegion.rows.Count - 2
Range("B65536").Select
[B65536].End(xlUp).Select
ActiveCell.Offset(8, 1).Select
ActiveCell.FormulaR1C1 = "VP"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Est. In"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Commit Amt."
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Total Commit"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Non Commit"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Upside"

Range(Selection, Selection.End(xlToLeft)).Select
With Selection
.WrapText = True
End With
With Selection.Interior
.ColorIndex = 55
.Pattern = xlSolid
End With
With Selection.Font
.ColorIndex = 2
.FontStyle = "Bold"
End With

Mousepoint = fmMousePointerDefault
' Close the current browser window
Window.Close
End Sub


Thanks in advance for all your help!

Sue
 
P

paul.robinson

Hi Sue
Which bit isn't working? What error messages do you get? Have you
tested each task separately:
Borders Task
Top Row format Task
Insert Calculations Task
Format Summary Section Task

Do they all not work, or only some of them?
Have you dim'd all your variables?

Very hard for anyone to give a useful reply as you havn't isolated your
problems.
regards
Paul
 
M

MarkTheNuke

Hello Sue,
It looks like your code is written to run within the Excel environment,
which it is not. To access the items in the spreadsheet you will have to
fully qualify your statements. (ie to access the selected cells
ExcelBook.Worksheet(1).Selection) Your code worked fine from within Excel so
your logic works. You just have to get it working from outside of Excel.
Mark

Sue said:
HI All:
I tried posting this yesterday, but my post seems to have disappeared,
so if this is a repeat I appologize.

I have a macro that someone else wrote and i'm trying to add to it some
formatting and summary data at the bottom after the details section,
but nothing seems to be working. To give you a background....this macro
is launched through SAP portal, when the user hits a "export to excel"
button in the portal. When the macro is launched, a new excel sheet is
created.

My code is attached to the bottom after the original code runs and
creates the excel file. I don't write VBA code so what I've written is
pretty basic, but is starting to get the job done when its run on its
own and not as part of the original code to launch and create the excel
file. The data in the file keeps changing depending on the user view of
the portal, but the sheet name stays the same in all cases.

I've attached the entire code below. Can anyone please help me!!

Sub FormatData()

' ****************************************

' ****************************************
On Error Resume Next

Window.resizeTo 0, 0
Window.moveTo -99, -99
Mousepoint = fmMousePointerHourGlass

Set ExcelApp = CreateObject("Excel.Application")
Set ExcelBook = ExcelApp.Workbooks.Add

ExcelBook.Worksheets(1).Name = "Deal Roadmap Data"
ExcelBook.Worksheets(1).Range("1:1").Font.Bold = True
ExcelBook.Worksheets(1).Range("Q:R").NumberFormat = "0"

Dim rows, cols, i, J

'Declare the array for storing data
'Note: VBScript array index staart 0, max 65536 rows in Excel
' This is the tage and dynamic code will be inserted here from CRM
application using ABAP

Dim ColumnTable(20)
ColumnTable(0) = "20"
Dim DataTable(5)
DataTable(0) = "5"
Dim aryData(5, 20)

ColumnTable(1) = "Closing date"
ColumnTable(2) = "Company"
ColumnTable(3) = "Description 2"
ColumnTable(4) = "Sales Office Name"
ColumnTable(5) = "Estimated in"
ColumnTable(6) = "Commit"
ColumnTable(7) = "*Total Commit*"
ColumnTable(8) = "Non Commit"
ColumnTable(9) = "OAF Upside"
ColumnTable(10) = "Reason"
ColumnTable(11) = "Exist. Customer"
ColumnTable(12) = "Exec.Sponsor Name"
ColumnTable(13) = "Bus.Sponsor Name"
ColumnTable(14) = "Service Partner Name"
ColumnTable(15) = "Competitor"
ColumnTable(16) = "Comments"
ColumnTable(17) = "Oppt. Owner Name"
ColumnTable(18) = "Sales Group Name"
ColumnTable(19) = "Opportunity ID"
ColumnTable(20) = "Current Phase"
DataTable(1) = "03/31/06|Preussag International Steel|WS04 DOUBLE
QUOTE|Cincinnati|0.00|450,000.00|450,000.00|0.00|0.00||||Customer
Business Sponsor|||action item 1 close plan checked
off;team;01.04.2006" + vbLf + "action item 2 close plan checked
off;all;11.04.2006" + vbLf + "action item 3 close plan checked
off;you;01.04.2006" + vbLf + "action item 5 close plan checked
off;tbd;01.03.2006" + vbLf + "action item 6 close plan checked
off;Value Engineer;21.04.2006 |William Yount|CPG -
Retail|0300003170|B|upd"
DataTable(2) = "03/31/06|C2|#9 (SUB ZU
#2)|Washington|0.00|360,000.00|360,000.00|0.00|0.00|||||||
|Frank Weiss|Healthcare|0300003343|B|upd"
DataTable(3) = "03/31/06|Preussag International Steel|TEST ACCT OWNER
E-MAIL|Consulting - Region North East|0.00|0.00|0.00|0.00|0.00|||||||
|William Yount|Consulting North East - CED1|0300003183|A|upd"
DataTable(4) = "03/31/06|Syskoplan Gesellschaft für System-1|CEL
TEST|Walldorf|0.00|0.00|0.00|0.00|0.00||X||||| |William
Yount|to be deleted|0300003758||upd"
DataTable(5) = "||||0.00|810,000.00|810,000.00|0.00|0.00|||||||
|||TOTAL||upd"
'{%INSERT_CRM_DYNAMIC%}

rows = DataTable(0)
cols = ColumnTable(0)

' Fill the column heading
For i = 1 To cols
ExcelBook.Worksheets(1).Cells(1, i).Value = ColumnTable(i)

Next

' Fill row data in array
For i = 1 To rows

Mousepoint = fmMousePointerHourGlass
DS = DataTable(i)
POS = 0

For J = 1 To cols
POS = InStr(DS, "|")
cell = Left(DS, POS - 1)
aryData(i - 1, J - 1) = cell
DS = Right(DS, Len(DS) - POS)
Next

'DS = Right(DS, Len(DS) - POS)
'aryData(i-1,cols) = DS

Next

If rows > 0 Then
' Set a range, which corresponds exactly to the array
Dim rng
Set rng = ExcelBook.Worksheets(1).Range("A2").Resize(rows, cols)

' Assign whole Array to Range
rng.Value = aryData
End If

ExcelApp.Visible = True
ExcelBook.Worksheets(1).Columns.AutoFit
ExcelBook.Worksheets(1).rows.AutoFit
ExcelBook.Worksheets(1).PageSetup.Orientation = xlLandscape
ExcelBook.Worksheets(1).PageSetup.PaperSize = xlPaperLetter
ExcelBook.Worksheets(1).PageSetup.Zoom = 55

'FROM HERE ON IS CODE THAT I WROTE AND IT DOESNT SEEM TO BE
WORKING!!!
Dim rw As Long
Dim LRow As Long

'Sort by Region
ExcelBook.Worksheets(1).Select
ExcelBook.Worksheets(1).Range("A1").Select

With ExcelBook.Worksheets(1)
Set myrows = ExcelBook.Worksheets(1).Range("A1").CurrentRegion
myrows.Sort Key1:=.Range("R1"), Order1:=xlAscending,
Header:=xlGuess
End With

'Format details section
ExcelBook.Worksheets(1).Select
ExcelBook.Worksheets(1).Range("A1").Select
ExcelBook.Worksheets(1).Range("A1").CurrentRegion.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Selection.Interior
.ColorIndex = 24
.PatternColorIndex = xlAutomatic
End With

'Format top row
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = True
End With
With Selection.Interior
.ColorIndex = 55
.Pattern = xlSolid
End With
With Selection.Font
.ColorIndex = 2
.FontStyle = "Bold"
End With
Range("A2").Select
Cells.Select
ActiveWindow.Zoom = 75
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
End With
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
Columns("B:D").Select
Selection.ColumnWidth = 21
Range("A2").Select

'insert total to the bottom/last row and add the formatting
LRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
Cells(LRow, "B").Value = "Total"
Set rng = Range(Cells(LRow, "A"), Cells(LRow, "T"))
With rng.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With rng.Interior
.ColorIndex = 55
.Pattern = xlSolid
End With
With rng.Font
.ColorIndex = 2
.FontStyle = "Bold"
End With
'Add totals to columns E - I
LRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
Cells(LRow, "E").Value = Application.Sum(Range(Cells(2, "E"),
Cells(LRow, "E")))
Cells(LRow, "F").Value = Application.Sum(Range(Cells(2, "F"),
Cells(LRow, "F")))
Cells(LRow, "G").Value = Application.Sum(Range(Cells(2, "G"),
Cells(LRow, "G")))
Cells(LRow, "H").Value = Application.Sum(Range(Cells(2, "H"),
Cells(LRow, "H")))
Cells(LRow, "I").Value = Application.Sum(Range(Cells(2, "I"),
Cells(LRow, "I")))

'Find the last row with data
If Not IsEmpty(Range("A" & rows.Count)) Then
rw = rows.Count
Else
rw = Cells(rows.Count, "A").End(xlUp).Row
End If

'Formatting the summary section
Range("b2").Select
myrows = Range("A1").CurrentRegion.rows.Count - 2
Range("B65536").Select
[B65536].End(xlUp).Select
ActiveCell.Offset(8, 1).Select
ActiveCell.FormulaR1C1 = "VP"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Est. In"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Commit Amt."
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Total Commit"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Non Commit"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "Upside"

Range(Selection, Selection.End(xlToLeft)).Select
With Selection
.WrapText = True
End With
With Selection.Interior
.ColorIndex = 55
.Pattern = xlSolid
End With
With Selection.Font
.ColorIndex = 2
.FontStyle = "Bold"
End With

Mousepoint = fmMousePointerDefault
' Close the current browser window
Window.Close
End Sub


Thanks in advance for all your help!

Sue
Click to expand...
 
S

Sue

Hi Mark,

Only the sort piece of the code seems to work, but all of the
formatting doesnt seem to work. I don't get any error messages thats
why I'm confused.

The code works in the excel environment.

Thanks,
 
M

MarkTheNuke

Hello Sue,
That is because the sort part uses full qualifiers. See the following code:
For i = 1 To cols
ExcelBook.Worksheets(1).Cells(1, i).Value = ColumnTable(i)

Next
That code works because it starts with an Excel Workbook and walks down the
object chain to what it wants to modify.
If you want to modify the formatting for a selection you would have to use
the following:
ExcelApp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
'Note that Excel workbook does not support a Selection Object for a workbook
I agree that your code works in Excel but it will not work in an ASP page
unless you include full object references. As for the errors, the first line
says 'ON ERROR RESUME NEXT' which shuts off error handling. If you want, you
can re-activate error handling before your code, by inserting the following
line 'ON ERROR GOTO 0'
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

help needed with borders 2
Border formatting row of cells 22
Hlp! Adv Filter - Non-Contiguous rows don't copy 11
Help with macro 1
Change code help 0
Macro to sort, format, sum, a dynamic set of data 2
Code debug 5
Looping Help Please 5

Top