Total columns

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
aneilgAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

dwe761Software EngineerCommented:
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
Rey Obrero (Capricorn1)Commented:
are the columns exported to Excel varies?
are the columns to be totaled always starts at Column D?
0
aneilgAuthor Commented:
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
10 Tips to Protect Your Business from Ransomware

Did you know that ransomware is the most widespread, destructive malware in the world today? It accounts for 39% of all security breaches, with ransomware gangsters projected to make $11.5B in profits from online extortion by 2019.

aneilgAuthor Commented:
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
aneilgAuthor Commented:
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
Rey Obrero (Capricorn1)Commented:
aneilg,
would you care to respond to the questions ask?
0
aneilgAuthor Commented:
dwe761 asked me to narrow it down to more specific code.

0
Rey Obrero (Capricorn1)Commented:
' ******************************************
' 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
aneilgAuthor Commented:
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
Rey Obrero (Capricorn1)Commented:
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
aneilgAuthor Commented:
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
Rey Obrero (Capricorn1)Commented:
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Rey Obrero (Capricorn1)Commented:
so, did it work?
0
aneilgAuthor Commented:
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
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.