Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

Total columns

Posted on 2009-07-02
14
Medium Priority
?
402 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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 120

Expert Comment

by:Rey Obrero (Capricorn1)
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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

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 120

Expert Comment

by:Rey Obrero (Capricorn1)
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
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
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 120

Expert Comment

by:Rey Obrero (Capricorn1)
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 120

Accepted Solution

by:
Rey Obrero (Capricorn1) earned 2000 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 120

Expert Comment

by:Rey Obrero (Capricorn1)
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

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Did you know that more than 4 billion data records have been recorded as lost or stolen since 2013? It was a staggering number brought to our attention during last week’s ManageEngine webinar, where attendees received a comprehensive look at the ma…
Explore the ways to Unlock VBA Project Password Excel 2010 & 2013 documents. Go through the article and perform the steps carefully to remove VBA Excel .xls file.
Learn how to number pages in an Access report over each group. Activate two pass printing by referencing the pages property: Add code to the Page Footers OnFormat event to capture the pages as there occur for each group. Use the pages property to …
Using Microsoft Access, learn some simple rules for how to construct tables in a relational database. Split up all multi-value fields into single values: Split up fields that belong to other things into separate tables: Make sure that all record…
Suggested Courses

604 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