Solved

Total columns

Posted on 2009-07-02
14
376 Views
Last Modified: 2013-12-25
i have the following code but i do not need to display the group totals only the grand total.
'Store Level History Report

Option Compare Database

Option Explicit
 

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

' This module calls the relevant Query and takes the values from the form

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

Dim objXLapp As Object

Dim objWB As Object

Dim objWS1 As Object
 

Dim Heading1, Heading2, Heading3, Heading4, Heading5, Heading6, Heading7, Heading8 As String   ' Used for the heading on the excel ouput

Dim Heading9, Heading10, Heading11, Heading12, Heading13, Heading14, Heading15, Heading16 As String
 

Dim RightHeader As String

'Dim RightHeader As String

Dim strSQL As String
 

Dim Tbl1  As String
 

Dim TotalColumn() As Integer
 

Sub GenerateExcelSpreadsheet()
 

Dim Tbl1 As String
 

    DoCmd.Hourglass (True)

    DoCmd.SetWarnings (False)

    

    Dim RecCount As Long
 

    On Error Resume Next

    DoCmd.DeleteObject acTable, "D Branch Raw Data Set"

    DoCmd.DeleteObject acTable, "SalesDpt"

    'SalesDpt

    On Error GoTo 0
 
 

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

' * Check to see if the table is populated   *

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

    DoCmd.OpenQuery "F Multiple Store History Raw Data maker"

    DoCmd.OpenQuery "FF Dept Qry Maker"

           

    Tbl1 = "FF Dept tbl"

     

    If (DCount("*", "[FF Dept tbl]") = 0) Then

        MsgBox "No records meet this criteria", vbInformation, "Store Dep Sales Period A"

        DoCmd.SetWarnings (True)

        DoCmd.Hourglass (False)

    End    ' If are no records so don't go any further

    End If   ' End of Count check
 
 

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

' * Finished Creating Tables, from the queries, depending on the users criteria   *

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

    RecCount = DCount("*", "[FF Dept tbl]")

    

    Set objXLapp = CreateObject("Excel.Application")

    

    With objXLapp

        .Visible = False  '                        ' << ---- To see Excel change to True

          '.Workbooks.Open MyDir & "Counts.xls"

        .Workbooks.Add

    End With
 

    Set objWB = objXLapp.ActiveWorkbook

    

    objXLapp.StatusBar = RecCount & " records"

    Set objWS1 = objXLapp.Worksheets(1)

    

    objWS1.Name = "Store Dep Sales Period A"
 
 

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

' From Access Open The Relevant Table and Copy To The Clipboard*

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

      ' Table 1

     DoCmd.SelectObject acTable, (Tbl1), True

     DoCmd.DoMenuItem acFormBar, acEditMenu, acCopy, , acMenuVer70

     DoCmd.Minimize

     'Forms!frmOrderBookQueries.SetFocus

     DoCmd.Maximize

    

     objWS1.Select

     objWS1.Cells(1, 1).Select

     objWS1.Paste

     objXLapp.CutCopyMode = False    ' Empty Clipboard

     

     DoCmd.SetWarnings (True)

     

     With objWS1.PageSetup

        .PrintTitleRows = "$1:$1"

        .PrintTitleColumns = ""

     End With

          

          

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

' Set the page properites *

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

    With objWS1.PageSetup

    

        '.LeftHeader = "&""Arial,Bold Italic""&16" & Heading1 & " " & Heading2 & " " & Heading3 & " " & Heading4

        

        '.CenterFooter = "&D, Page &P of &N"

        '.RightFooter = ""

                       

        .CenterHeader = "Store Dep Sales Period A"

        .RightHeader = "&D"

        .CenterFooter = "Page &P of &N"

        

        .LeftMargin = objXLapp.InchesToPoints(0.6)

        .RightMargin = objXLapp.InchesToPoints(0.6)

        .TopMargin = objXLapp.InchesToPoints(0.75)

        .BottomMargin = objXLapp.InchesToPoints(0.65)

        .HeaderMargin = objXLapp.InchesToPoints(0.5)

        .FooterMargin = objXLapp.InchesToPoints(0.5)

         

        .Orientation = xlLandscape

        

        'Fit to one page wide ....

        .Zoom = False

        .FitToPagesWide = 1

        .FitToPagesTall = 1000

        

    End With

          

    ' Set the column widths and font size...

     objWS1.Cells(1, 1).CurrentRegion.Select

        

     With objWS1.Cells.Font

        .Name = "Arial"

        .Size = 8

        '.Bold = "True"

        '.Width = 10

     End With

          

          

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

' To work through each column,check the headings and then format each column....

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

Dim a As Integer

Dim Workfld As String

Dim FldName As String

Dim FldType As String

Dim ColWidth As Integer

Dim NumOfRows As Integer

     

    NumOfRows = objWS1.Cells(1, 1).CurrentRegion.Rows.Count

    

    'Change the row height of the top row...

    objWS1.Rows("1:1").RowHeight = 40

    objWS1.Rows("1:1").Interior.ColorIndex = xlNone
 

    'Change the row height of the rows..

    

    DoCmd.Hourglass (True)

    ' Loop through each column

        For a = 1 To objWS1.Cells(1, 1).CurrentRegion.Columns.Count

    

             Workfld = objWS1.Cells(1, a)

             

             Select Case Workfld   ' Workfld contains the field heading

              '1

                Case "BR"

                    FldName = "BR"

                    FldType = "General"

                    ColWidth = 7

                '2

                Case "Branch"

                    FldName = "Branch"

                    FldType = "General"

                    ColWidth = 25

                '3

                Case "Dept"

                    FldName = "BR"

                    FldType = "General"

                    ColWidth = 3

                '4

                Case "Total £ Sales"

                    FldName = "Total £ Sales"

                    FldType = "Number0"

                    ColWidth = 15

                '5

                 Case "WK"

                    'FldName = "Total £ Sales"

                    FldType = "Number0"

                    ColWidth = 15

                 '6

                 Case "fiscyrpercode"

                    'FldName = "Total £ Sales"

                    FldType = "Number0"

                    ColWidth = 15
 

             Case Else

             

             FldName = Workfld

             FldType = "General"

    

            End Select

                         

            objWS1.Cells(1, a) = FldName ' Change the field name,if required

            

            'Format the columns that are made up from the CT query.

            If (FldName Like "200*") Then

                FldType = "Number0"

            End If

            

            'If (FldName Like "Stk *") Then

                'FldType = "Number0"

            'End If

            

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

'*Change the format of the field*

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

            If (FldType = "General") Then

                objWS1.Columns(a).NumberFormat = "General"

            End If
 

            If (FldType = "Percent") Then

                objWS1.Columns(a).NumberFormat = "0%"

            End If

        

            If (FldType = "Number0") Then

                objWS1.Columns(a).NumberFormat = "£#,##0"

            End If

        

            If (FldType = "Number2") Then

                objWS1.Columns(a).NumberFormat = "#,##0.00"

            End If

        

            If (FldType = "Number3") Then

                objWS1.Columns(a).NumberFormat = "0"

            End If

        

            If (FldType = "Currency") Then

                objWS1.Columns(a).NumberFormat = "£#,###0.00"

            End If

    

            If (FldType = "Currency2") Then

                objWS1.Columns(a).NumberFormat = "£#,###"

            End If

    

            If (FldType = "Currency3") Then

                objWS1.Columns(a).NumberFormat = "£#,###0"

            End If

    

            If (FldType = "Currency3") Then

                objWS1.Columns(a).NumberFormat = "£#,###0"

            End If

            

                If (FldType = "ShortDate") Then

                objWS1.Columns(a).NumberFormat = "dd/mm/yy;@"

        End If
 

'''''''''''''''''''''

' Re wrap the column'

'''''''''''''''''''''

            objWS1.Cells(1, a).HorizontalAlignment = xlCenter

            objWS1.Cells(1, a).VerticalAlignment = xlBottom

            objWS1.Cells(1, a).WrapText = True

            objWS1.Columns(a).ColumnWidth = ColWidth

 

         Next a

 

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

' * Sub Total  *

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

    ' Ok so we need to loop through the columns

    Dim STCounter, LoopCounter, iArraySize As Integer ' Sub Total Counter

    STCounter = 0

       

    Dim CurrFldType As Variant

    Dim NumOfColumns As Integer

    

    NumOfColumns = objWS1.Cells(1, 1).CurrentRegion.Columns.Count

    

    a = 1                      ' Increment Counter

    LoopCounter = 0

    

    ' Work out which columns are a number...

    Do

    

      a = a + 1

      CurrFldType = objWS1.Cells(2, a).NumberFormat

      If (Left(CurrFldType, 1) = "£") Then    ' If number format

            ReDim Preserve TotalColumn(STCounter) As Integer

            TotalColumn(STCounter) = a

            STCounter = (STCounter + 1)

            'objWS1.Cells.EntireColumn.AutoFit

      End If

    Loop Until a = NumOfColumns

 

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

' Resize the array

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

    iArraySize = UBound(TotalColumn)  ' Find the number of array elements that have been used.

    ReDim Preserve TotalColumn(iArraySize) As Integer  ' Redifine the array to the upper limit

    

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

' Display which columns will be sub totalled

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

     With objWS1.Cells(1, 1).CurrentRegion

            .RemoveSubtotal

            '.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=(Array(TotalColumn())), _

                'Replace:=True, PageBreaks:=False, SummaryBelowData:=False

            

            .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=(Array(TotalColumn())), _

                Replace:=True, PageBreaks:=False, SummaryBelowData:=False

                

     End With

     

     Dim tbl As Object

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

'   Apply Borders and Totals*

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

     Set tbl = objWS1.Cells(NumOfRows, 1).CurrentRegion

     

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

' Complete the formatting on the table

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

     NumOfRows = objWS1.Cells(1, 1).CurrentRegion.Rows.Count

     a = NumOfRows

     

     NumOfColumns = objWS1.Cells(1, 1).CurrentRegion.Columns.Count

        

     Do

        

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

        ' *  Apply Borders to the table   *

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

        If (objWS1.Cells(a, 1).Font.Bold = True) Then

                

                objWS1.Cells(a, 1).Font.Bold = True

                objWS1.Cells(a, 1).WrapText = False

                objWS1.Cells(a, 1) = objWS1.Cells(a, 1)
 

                    If (objWS1.Cells(a, 1) <> "GRAND TOTAL") Then

                            

                            'Insert a blank row

                            objWS1.Rows(a + 1).Insert Shift:=xlDown

                            objWS1.Cells(a + 1, 1) = "     "

                                                            

                            ' Remove various Borders

                            Set tbl = objWS1.Range(objWS1.Cells(a + 1, 1), objWS1.Cells(a + 1, NumOfColumns))

                            

                            tbl.Select

                            

                            With tbl

                                .Borders(xlEdgeLeft).LineStyle = xlNone

                                '.Borders(xlEdgeTop).LineStyle = xlNone

                               ' .Borders(xlEdgeBottom).LineStyle = xlNone

                                .Borders(xlEdgeRight).LineStyle = xlNone

                                .Borders(xlInsideVertical).LineStyle = xlNone

                            End With

                            

                            Set tbl = objWS1.Range(objWS1.Cells(a, 1), objWS1.Cells(a, NumOfColumns))

                            'tbl.Select

                            

                            With tbl.Borders(xlEdgeTop)

                                .LineStyle = xlContinuous

                                .Weight = xlThin

                                .ColorIndex = xlAutomatic

                            End With

                            

                            ' Insert Page Break after total

                            objWS1.Rows(a + 1).Select

                            objWS1.Cells(a + 1, 1).Activate
 

                    End If

        End If

     a = (a - 1)

     Loop Until a = 0

 

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

 'Add a line above the totals column*

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

      NumOfColumns = objWS1.Cells(1, 1).CurrentRegion.Columns.Count

     

       'Grand Total

     NumOfRows = objWS1.Cells(1, 1).CurrentRegion.Rows.Count

       If (objWS1.Cells(NumOfRows, 1) = "GRAND TOTAL") Then

        

        'objWS1.Cells(NumOfRows, 11) = ""   ' Blank the Grand Total

        objWS1.Cells(NumOfRows, 1) = "Grand Total"

        objWS1.Cells(NumOfRows, 1).Font.Bold = True

        objWS1.Cells(NumOfRows, 2) = ""

        'objWS1.Cells(NumOfRows, 3) = Null

        'objWS1.Cells(NumOfRows, 3).Font.Bold = False

            

        Set tbl = objWS1.Cells(NumOfRows, 1)

        

        'expression.Range(Cell1, Cell2)
 

        Set tbl = objWS1.Range(objWS1.Cells(NumOfRows, 1), objWS1.Cells(NumOfRows, NumOfColumns))
 

            tbl.Select

        

            tbl.Offset(NumOfRows - 1, 0).Resize(1, tbl.Columns.Count).Select

                    

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

            ' Apply Borders To The Selection

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

            

            'Top Single Border

            With tbl.Borders(xlEdgeTop)

                    .LineStyle = xlContinuous

                    .Weight = xlThin

                    .Weight = xlHairline

                    .ColorIndex = 1

            End With

            

            ' Bottom Double Border

            With tbl.Borders(xlEdgeBottom)

                    .LineStyle = xlDouble

                    .Weight = xlThick

                    .ColorIndex = xlAutomatic

            End With

            

            ' Don't bother wrapping the text at the bottom

            ' this will bottom align the text..

            tbl.WrapText = False

        

            objWS1.Cells(NumOfRows, 1).Select

            

        End If

     

        objWS1.Cells(1, 1).Select

        objXLapp.StatusBar = ""

 

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

 'Resize the columns*

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

        objWS1.Cells.EntireColumn.AutoFit

        objWS1.Cells.EntireRow.AutoFit

        objWS1.Cells(1, 1).Select

        objXLapp.CutCopyMode = False

        

         NumOfRows = objWS1.Cells(1, 1).CurrentRegion.Rows.Count

 

    ' Apply the borders to the page'

     With objWS1.Cells(1, 1).CurrentRegion.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .Weight = xlHairline

        .ColorIndex = 1

     End With

     With objWS1.Cells(1, 1).CurrentRegion.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .Weight = xlHairline

        .ColorIndex = 1

     End With

     'With objWS1.Cells(1, 1).CurrentRegion.Borders(xlEdgeBottom)

        '.LineStyle = xlContinuous   'instead of double edge

        '.Weight = xlHairline

        '.ColorIndex = 1

     'End With

     With objWS1.Cells(1, 1).CurrentRegion.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .Weight = xlHairline

        .ColorIndex = 1

     End With

     With objWS1.Cells(1, 1).CurrentRegion.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .Weight = xlHairline

        .ColorIndex = 1

     End With

     

     If (NumOfRows > 1) Then   ' If there is only 1 row then it will fall over

       With objWS1.Cells(1, 1).CurrentRegion.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .Weight = xlHairline

        .ColorIndex = 1

       End With

     End If

    

     

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

' *  Close The Excel Workbook and Then Application  *

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

    objXLapp.Visible = True             ' Excel Visiable on Taskbar

    objXLapp.DisplayAlerts = False
 

    Set objWB = Nothing                 ' Empty Memory of Objects

    Set objWS1 = Nothing

    Set objXLapp = Nothing

    

    DoCmd.SetWarnings (True)

    DoCmd.Hourglass (False)
 

End Sub

Open in new window

Totals.xls
0
Comment
Question by:aneilg
  • 7
  • 6
14 Comments
 
LVL 10

Expert Comment

by:dwe761
ID: 24763450
Wow.  You're asking a lot to look at all of this code.  Could you be a little more specific where you're having trouble and how this code fits into your Access application?
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 24763547
are the columns exported to Excel varies?
are the columns to be totaled always starts at Column D?
0
 

Author Comment

by:aneilg
ID: 24763729
this is the bit of code that does the sum.

if you look at the spreadsheet, the acturl grad total gets displayed, but it's totalling everything by

With objWS1.Cells(1, 1).CurrentRegion
            .RemoveSubtotal
            .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=(Array(TotalColumn())), _
                Replace:=True, PageBreaks:=False, SummaryBelowData:=False
               
     End With

when all i want to display is the grand total

Code that does the sum
' **************
' * Sub Total  *
' **************
    ' Ok so we need to loop through the columns
    Dim STCounter, LoopCounter, iArraySize As Integer ' Sub Total Counter
    STCounter = 0
       
    Dim CurrFldType As Variant
    Dim NumOfColumns As Integer
   
    NumOfColumns = objWS1.Cells(1, 1).CurrentRegion.Columns.Count
   
    a = 1                      ' Increment Counter
    LoopCounter = 0
   
    ' Work out which columns are a number...
    Do
   
      'a = 1
      a = a + 1
      CurrFldType = objWS1.Cells(2, a).NumberFormat
      If (Left(CurrFldType, 1) = "£") Then    ' If number format
            ReDim Preserve TotalColumn(STCounter) As Integer
            TotalColumn(STCounter) = a
            STCounter = (STCounter + 1)
            'objWS1.Cells.EntireColumn.AutoFit
      End If
    Loop Until a = NumOfColumns
 
 ' ****************
' Resize the array
' ****************
    iArraySize = UBound(TotalColumn)  ' Find the number of array elements that have been used.
    ReDim Preserve TotalColumn(iArraySize) As Integer  ' Redifine the array to the upper limit
   
' ******************************************
' Display which columns will be sub totalled
' ******************************************
     With objWS1.Cells(1, 1).CurrentRegion
            .RemoveSubtotal
            .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=(Array(TotalColumn())), _
                Replace:=True, PageBreaks:=False, SummaryBelowData:=False
               
     End With
     
     Dim tbl As Object
' ***************************
'   Apply Borders and Totals*
' ***************************
     Set tbl = objWS1.Cells(NumOfRows, 1).CurrentRegion
     
' ************************************
' Complete the formatting on the table
' ************************************
     NumOfRows = objWS1.Cells(1, 1).CurrentRegion.Rows.Count
     a = NumOfRows
     
     NumOfColumns = objWS1.Cells(1, 1).CurrentRegion.Columns.Count
       
     Do
       
        ' *********************************
        ' *  Apply Borders to the table   *
        ' *********************************
        If (objWS1.Cells(a, 1).Font.Bold = True) Then
               
                objWS1.Cells(a, 1).Font.Bold = True
                objWS1.Cells(a, 1).WrapText = False
                objWS1.Cells(a, 1) = objWS1.Cells(a, 1)

                    If (objWS1.Cells(a, 1) <> "GRAND TOTAL") Then
                           
                            'Insert a blank row
                            objWS1.Rows(a + 1).Insert Shift:=xlDown
                            objWS1.Cells(a + 1, 1) = "     "
                                                           
                            ' Remove various Borders
                            Set tbl = objWS1.Range(objWS1.Cells(a + 1, 1), objWS1.Cells(a + 1, NumOfColumns))
                           
                            tbl.Select
                           
                            With tbl
                                .Borders(xlEdgeLeft).LineStyle = xlNone
                                '.Borders(xlEdgeTop).LineStyle = xlNone
                               ' .Borders(xlEdgeBottom).LineStyle = xlNone
                                .Borders(xlEdgeRight).LineStyle = xlNone
                                .Borders(xlInsideVertical).LineStyle = xlNone
                            End With
                           
                            Set tbl = objWS1.Range(objWS1.Cells(a, 1), objWS1.Cells(a, NumOfColumns))
                            'tbl.Select
                           
                            With tbl.Borders(xlEdgeTop)
                                .LineStyle = xlContinuous
                                .Weight = xlThin
                                .ColorIndex = xlAutomatic
                            End With
                           
                            ' Insert Page Break after total
                            objWS1.Rows(a + 1).Select
                            objWS1.Cells(a + 1, 1).Activate

                    End If
        End If
     a = (a - 1)
     Loop Until a = 0
0
 

Author Comment

by:aneilg
ID: 24763826
this is prob all i need.
basically i want to loop through all the columns that have a £ in the column then have a grand total displayed at the top.

' **************
' * Sub Total  *
' **************
    ' Ok so we need to loop through the columns
    Dim STCounter, LoopCounter, iArraySize As Integer ' Sub Total Counter
    STCounter = 0
       
    Dim CurrFldType As Variant
    Dim NumOfColumns As Integer
   
    NumOfColumns = objWS1.Cells(1, 1).CurrentRegion.Columns.Count
   
    a = 1                      ' Increment Counter
    LoopCounter = 0
   
    ' Work out which columns are a number...
    Do
   
      'a = 1
      a = a + 1
      CurrFldType = objWS1.Cells(2, a).NumberFormat
      If (Left(CurrFldType, 1) = "£") Then    ' If number format
            ReDim Preserve TotalColumn(STCounter) As Integer
            TotalColumn(STCounter) = a
            STCounter = (STCounter + 1)
            'objWS1.Cells.EntireColumn.AutoFit
      End If
    Loop Until a = NumOfColumns
 
 ' ****************
' Resize the array
' ****************
    iArraySize = UBound(TotalColumn)  ' Find the number of array elements that have been used.
    ReDim Preserve TotalColumn(iArraySize) As Integer  ' Redifine the array to the upper limit
   
' ******************************************
' Display which columns will be sub totalled
' ******************************************
     With objWS1.Cells(1, 1).CurrentRegion
            .RemoveSubtotal
            .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=(Array(TotalColumn())), _
                Replace:=True, PageBreaks:=False, SummaryBelowData:=False
               
     End With
0
 

Author Comment

by:aneilg
ID: 24763869
sorry to be a aplin.

But its this bit that seem sto be causing the problem.
' ******************************************
' Display which columns will be sub totalled
' ******************************************
     'With objWS1.Cells(1, 1).CurrentRegion
            '.RemoveSubtotal
            '.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=(Array(TotalColumn())), _
                'Replace:=True, PageBreaks:=False, SummaryBelowData:=False
               
     'End With

The groupby subtotal bit.
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 24764028
aneilg,
would you care to respond to the questions ask?
0
 

Author Comment

by:aneilg
ID: 24764089
dwe761 asked me to narrow it down to more specific code.

0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
LVL 119

Expert Comment

by:Rey Obrero
ID: 24764667
' ******************************************
' Display which columns will be sub totalled
' ******************************************
'     With objWS1.Cells(1, 1).CurrentRegion
'            .RemoveSubtotal
'            .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=(Array(TotalColumn())), _
'                Replace:=True, PageBreaks:=False, SummaryBelowData:=False
               
'     End With


Dim iRow As Integer, iCol As Integer, varCol As String
Dim varColRange As String, vCol As Integer

With objWS1
        iRow = .UsedRange.Rows.Count
        Debug.Print iRow
        iCol = .UsedRange.Columns.Count
        For vCol = 4 To iCol
            varCol = Chr(vCol + 64) & iRow + 1
            varColRange = Chr(vCol + 64) & "2:" & Chr(vCol + 64) & iRow
            .Range(varCol).Formula = "=SUM(" & varColRange & ")"
        Next
End With




0
 

Author Comment

by:aneilg
ID: 24764854
thanks for that, i've no idea how it works.

Is there any way to display GrandTotal in bold in the column as well.

Once again thanks for your help.
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 24765038
Dim iRow As Integer, iCol As Integer, varCol As String
Dim varColRange As String, vCol As Integer

With objWS1
        iRow = .UsedRange.Rows.Count
        iCol = .UsedRange.Columns.Count
        For vCol = 4 To iCol
            varCol = Chr(vCol + 64) & iRow + 1
            varColRange = Chr(vCol + 64) & "2:" & Chr(vCol + 64) & iRow
            .Range(varCol).Formula = "=SUM(" & varColRange & ")"
        Next
        .Range("A" & iRow + 1).Value = "Grand Total"
        .Range("A" & iRow + 1).EntireRow.Font.Bold = True
End With
0
 

Author Comment

by:aneilg
ID: 24765114
Dude your a superstar in your own life time.

Sorry just one last question.

Is there an easy way to have this column displayed below the heading.
Or will the  calculations be messed up.
0
 
LVL 119

Accepted Solution

by:
Rey Obrero earned 500 total points
ID: 24765276
Dim iRow As Integer, iCol As Integer, varCol As String
Dim varColRange As String, vCol As Integer

With objWS1
        .Range("A2").EntireRow.Insert
        .Range("A2").Value = "Grand Total"
        iRow = .UsedRange.Rows.Count
        iCol = .UsedRange.Columns.Count
        For vCol = 4 To iCol
            varCol = Chr(vCol + 64) & 2
            varColRange = Chr(vCol + 64) & "3:" & Chr(vCol + 64) & iRow
            .Range(varCol).Formula = "=SUM(" & varColRange & ")"
        Next
        .Range("A2").EntireRow.Font.Bold = True
End With
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 24765871
so, did it work?
0
 

Author Comment

by:aneilg
ID: 24770744
Thankk you so much.
I am just gonna test it now.
Looks fine.

Sorry i have just go tback to you, i was pulled into a meeting last thing last night.

I owe you a few Jars.
0

Featured Post

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Suggested Solutions

Introduction The Visual Basic for Applications (VBA) language is at the heart of every application that you write. It is your key to taking Access beyond the world of wizards into a world where anything is possible. This article introduces you to…
I see at least one EE question a week that pertains to using temporary tables in MS Access.  But surprisingly, I was unable to find a single article devoted solely to this topic. I don’t intend to describe all of the uses of temporary tables in t…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
With Microsoft Access, learn how to specify relationships between tables and set various options on the relationship. Add the tables: Create the relationship: Decide if you’re going to set referential integrity: Decide if you want cascade upda…

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now