Excel VBA in Access to format spreadsheet

[gillianleec]

I have a series of queries that I transfer to a workbook and then format using VBA. My problem is the section of code below that only works correctly on the first spreadsheet.

Dim xlApp As Excel.Application
Dim objExcel As Object
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = New Excel.Application


Set db = CurrentDb
Set rs = db.OpenRecordset("Select DISTINCT tabname, query, columns, sum, deletecolumn, sumcolumn, cletter from tblExcelTabDefs where Type ='" & Me.cboPType & "';")

rs.MoveLast
rs.MoveFirst

Do While Not rs.EOF
strTitle = rs.Fields(0)
strQry = rs.Fields(1)
strcolumn = rs.Fields(2)
strSum = rs.Fields(3)
strDColumn = rs.Fields(4)
strSColumn = rs.Fields(5)
strLet = rs.Fields(6)

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel3, strQry, "C:\Documents and Settings\glcoykendall\My Documents\" & Me.cboService.Value & strReport, True
Set xlApp = New Excel.Application
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Open("C:\Documents and Settings\glcoykendall\My Documents\" & Me.cboService.Value & strReport)
Set xlSheet = xlBook.Sheets(strQry)

If objExcel Is Nothing Then
Set objExcel = New Excel.Application
objExcel.EnableEvents = False 'disable Excel save messages
End If
Dim aArea As Object
Dim i As Integer

Set aArea = xlSheet.Range("A:A")

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Check to see if this is a sheet that needs to be summed and then perform insert and sum calculation
'****************************************************************************************************



If IsNull(strSColumn) = False Then



'*****Insert Row between Unique Column 1 Values*****

For i = xlSheet.Range("A5000").End(xlUp).Row To 3 Step -1


If xlSheet.Range("A" & i) <> xlSheet.Range("A" & i - 1) Then
xlSheet.Range("A" & i).EntireRow.Insert shift:=xlDown
End If
Next i

'*****Perform Sum of each section between inserted rows*****


i = 0
For Each aArea In xlSheet.UsedRange.SpecialCells(xlCellTypeConstants).Areas

i = i + 1



If i <> 1 Then

With xlSheet.Cells(aArea.Row + aArea.Rows.Count, strSColumn)
.Value = WorksheetFunction.Sum(xlSheet.Range(xlSheet.Cells(aArea.Row, strSColumn), xlSheet.Cells(aArea.Row + aArea.Rows.Count, strSColumn)))

With .Font
.ColorIndex = 5
.Bold = True
End With
End With
End If
Next aArea
'End With

End If



xlBook.Save

With xlBook
.Save
End With
'Set xlSheet = Nothing
Set aArea = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

rs.MoveNext
Loop

rs.Close
Set rs = Nothing



The section that is not working is this part: With xlSheet.Cells(aArea.Row + aArea.Rows.Count, strSColumn)
.Value = WorksheetFunction.Sum(xlSheet.Range(xlSheet.Cells(aArea.Row, strSColumn), xlSheet.Cells(aArea.Row + aArea.Rows.Count, strSColumn)))

It works for the first sheet but subsequent sheets only have a zero where the sum should be.

Thanks,
Gillian

 

[SkipVought]

hi,

EXACTLY what does "only works correctly on the first spreadsheet" mean?

What INCORRECT thing(s) happens and what should the CORRECT thing(s) be?

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[gillianleec]

The first spreadsheet has the previous cells summed. The subsequent spreadsheets have a 0 in the cell where the sum should be although it is formatted correctly with color and bold.

 

[SkipVought]

Please explain what it is that your summing logic should be doing.

Please be detailed in your explanation of each step that is to be performed.

Please explain how you determine the "previous" cells to be summed.

Please provide a response to each of the requests.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[gillianleec]

For each spreadsheet transferred the code:
1. Evaluates the values in the A column and inserts a row when a new set of values begins

A B becomes A B
Test1 10 Test1 10
Test1 20 Test1 20
Test1 30 Test1 30
Test2 10
Test2 20 Test2 10
Test2 20 Test2 20
Test2 20



For i = xlSheet.Range("A5000").End(xlUp).Row To 3 Step -1


If xlSheet.Range("A" & i) <> xlSheet.Range("A" & i - 1) Then
xlSheet.Range("A" & i).EntireRow.Insert shift:=xlDown
End If
Next i

2. Sums the values in the strSColumn for each set with a unique value in A and places that value in the empty cell that is below each area in that same column and formats the cell to be font color blue and bold.
Example
strSColumn=B

A B
Test1 10
Test1 20
Test1 30
<B>60</B>
Test2 10
Test2 20
Test2 20
<B>50</B>

Here is the code that does that

i = 0
For Each aArea In xlSheet.UsedRange.SpecialCells(xlCellTypeConstants).Areas

i = i + 1



If i <> 1 Then

With xlSheet.Cells(aArea.Row + aArea.Rows.Count, strSColumn)
.Value = WorksheetFunction.Sum(xlSheet.Range(xlSheet.Cells(aArea.Row, strSColumn), xlSheet.Cells(aArea.Row + aArea.Rows.Count, strSColumn)))

With .Font
.ColorIndex = 5
.Bold = True
End With
End With
End If
Next aArea
'End With

End If

3. The area to be summed is determined by the value in Column A. Matching values are grouped together (aArea).



4. When I run this, all the spreadsheets transfer properly, rows are inserted and a value is entered in the cell where the sum should be. The problem is that on the first worksheet in the workbook, there are values but on subsequent worksheets in the workbook, there is just a zero. My guess is that I am not releasing something properly or activating something but I am not sure what.

Thanks for your help. Please let me know if you need more info.

 

[SkipVought]

Why don't you use the Subtotal feature, native to Excel. It does EXACTLY that! The the Conditional Formatting feature can do whatever shading emphasis.

NO VBA required, and can be accomplished in less than 5 minutes!

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[gillianleec]

When you say no VBA, do you mean that I should use the subtotal function on my spreadsheet directly rather than applying the format through Access. I am trying to do all formatting with Access at time of transfer.

I have tried experimenting with this
WorksheetFunction.subtotal(9, (xlBook.Sheets(strQry).Range(strLet & aArea.Row & ":" & strLet & aArea.Row + aArea.Rows.Count)))

but am getting a type mismatch error and it does not seem to recognize the function.

 

[SkipVought]

I did NOT refer to the Subtotal FUNCTION!

I DID refer to the Subtotal FEATURE in the Data tab.

NO VBA required, unless you want to RECORD applying the Subtotal Wizard.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[gillianleec]

I am trying to do this without touching the spreadsheets as I am passing this off to users who do not have that level of technical expertise.

 

[SkipVought]

As I previously stated, "NO VBA required, unless you want to RECORD applying the Subtotal Wizard."

Like any other VBA approch, if it can be done on a sheet, it can be done in VBA.

Doing it this way, an intermediate or advanced Excel user can run the this feature. Your original way would annoy me no end as a user, because you have DESTROYED the usefulness of the sheet with your "subtotals," without serious post massaging!

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[gillianleec]

Skip, I understand perfectly what you were saying but it wasn't what I WAS looking for. Perhaps you didn't understand me.

For those who want to know how to do this. I ended up using VBA to put a Subtotal formula into the inserted cell and calculating the area that needed to be subtotaled.

Here is the code:
With xlSheet.Cells(aArea.Row + aArea.Rows.Count, strSColumn)
.Formula = "=subtotal(9, " & strLet & aArea.Row & ":" & strLet & aArea.Row + aArea.Rows.Count - 1 & ")"


This replaced this code in the above posting:

With xlSheet.Cells(aArea.Row + aArea.Rows.Count, strSColumn)
.Value = WorksheetFunction.Sum(xlSheet.Range(xlSheet.Cells(aArea.Row, strSColumn), xlSheet.Cells(aArea.Row + aArea.Rows.Count, strSColumn)))

Gillian

 

[SkipVought]

Why mess with coding VBA from scratch, when you can record the Subtotal Wizard feature. The CF can be configured ONE TIME on the sheet to emphasize rows where Total appears in a cell.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]