VBA Code falling over

[TartanSpecial]

Hi there

I've inherited a report from a colleague who's unfortunately left the company and one of the Macros' doesn't seem to work

The code is actually written in Business Objects but it exports the data to Microsoft Excel. The code falls over on

' Resize and format cells

.Cells.VerticalAlignment = xlVAlignCenter
.Columns(2).ColumnWidth = 28
.Columns(2).WrapText = True

.Columns(3).AutoFit




With .Columns(4).Resize(, cellsacross - 1)
.AutoFit
.HorizontalAlignment = xlCenter
End With

The problem seems to arise when there is no data in that column

Does anyone know why this might happen

Thanks very much


Nick

 

[Richard Schollar]

Hi Nick

What value does the variable "cellsacross" hold when the code fails? Also, what error message do you receive?

Best regards

Richard

 

[TartanSpecial]

Thanks

Thanks for getting back to me

The error says

Run-time error '1004'

Application-defined or object-defined error

Cellsacross has value 256

thanks
nick

 

[Norie]

nick

If cellsacross is 256 then that's probably why you are getting the error.

The resize here is trying to extend column 4 to cellsacross-1.

Now if cellsacross is 256 then by my reckoning that's extending out to column 259, and at the moment Excel only has 256 columns, hence the error.

 

[TartanSpecial]

Thanks

Cheers for that. I'm not sure how to fix the problem (I've only got very limited VBA knowlege). The code before that is below. As mentioned the data seems to work fine when there is a full set of data it just seems to fall over when there is little data to export.

If anyone has any thoughts it would be great appreciated

Thanks a lot

Nick

Sub create_excel_doc()


Dim BO_CmdBarPopUp As CmdBarPopup
Dim BO_CmdBarPopUp1 As CmdBarPopup
Dim BO_CmdBarControl As CmdBarControl
Dim i As Integer
Dim wksht As Object
Dim xlApp As Object

Set xlApp = CreateObject("excel.application")

xlApp.Workbooks.Add
xlApp.Visible = True

' Copy the sheet into the newly-created Excel sheet

ActiveDocument.Reports.Item(1).Activate

Set BO_CmdBarPopUp = Application.CmdBars.Item(2).Controls.Item(2)
BO_CmdBarPopUp.CmdBar.Controls.Item(23).Execute

xlApp.Sheets(1).Select
xlApp.ActiveSheet.Paste
xlApp.Sheets(1).Name = ActiveDocument.Reports.Item(1).Name


' Format the resulting sheet

' firstly, shift all the cell contents for each analyst onto the same row

xlApp.ScreenUpdating = False

With xlApp.Sheets(1)
cellsacross = .Range("D1").End(xltoRight).Column

finished = False
rownum = 2

While Not finished

' if the A column is blank then row should be shifted up

If .Range("B" & rownum) = "" Then

' Find which cell the location is in

found = False

For x = 4 To cellsacross
If .Cells(rownum, x) <> "" Then
If .Cells(rownum - 1, x) <> "" Then
.Cells(rownum - 1, x) = .Cells(rownum - 1, x) & "/" & .Cells(rownum, x)
Else
.Cells(rownum - 1, x) = .Cells(rownum, x)
End If
found = True
End If

Next x

If found = False Then
' We've potentially reached the end of the document, check the cell below
' If it's empty we have

If .Range("B" & rownum + 1) = "" Then
finished = True
End If
End If

.Rows(rownum).EntireRow.Delete
Else
' if it is a private event, italicise the row

If .Range("C" & rownum) = "N" Then
.Rows(rownum).Font.Bold = True
End If

rownum = rownum + 1
End If

Wend

.Columns(3).EntireColumn.Delete

' Resize and format cells

.Cells.VerticalAlignment = xlVAlignCenter
.Columns(2).ColumnWidth = 28
.Columns(2).WrapText = True

.Columns(3).AutoFit

With .Columns(4).Resize(, cellsacross - 1)

 

[Richard Schollar]

Hi Nick

Without getting too involved in the coding you're using, one way to make sure the code doesn't fall over would probably be to assign the value to cellsacross a little differently. So the line where you have:

cellsacross = .Range("D1").End(xltoRight).Column

could probably be written as:

cellsacross = application.worksheetfunction.Max(.Range("IV1").End(xltoLeft).Column,4)

This does assume that you won't have situations where you have data in the 255th column of the worksheet. Give it a try, and come back if it's still crashing.

Richard