VBA for a dynamic table

[Tigerexcel]

Hi all,

I receive spreadsheets that primarily require both column and row addition. The problem is that when I receive these spreadsheets they may have a different number of rows and columns compared to the last spreadsheet. I may receive a number of them on the same day, all with differing numbers of rows/columns. What I was hoping for was a macro that totals both columns and rows and transfers the new table onto a new worksheet. There are 2 separate actions required here I guess, add the totals to whatever figures I receive, then transfer the entire worksheet to another tab within the same workbook. My main problem is working out the VBA for the changing dimensions of the tables. The tables received vary from 12 rows x 12 columns to 1000 rows x 36 columns.

 

[CephasOz]

Hi again Tigerexcel. Your main problem may be resolved by the following code (assuming that you have headers in row 1):

Sub AddTotals()
    Dim dblNoOfRows As Double
    Dim dblNoOfCols As Double
    With ActiveSheet
        dblNoOfRows = .Cells(1, 1).CurrentRegion.Rows.CountLarge
        dblNoOfCols = .Cells(1, 1).CurrentRegion.Columns.CountLarge
        With .Range(.Cells(dblNoOfRows + 1, 1), .Cells(dblNoOfRows + 1, dblNoOfCols + 1))
            .FormulaR1C1 = "=Sum(r2c:r[-1]c)"
        End With
        With .Range(.Cells(2, dblNoOfCols + 1), .Cells(dblNoOfRows + 1, dblNoOfCols + 1))
            .FormulaR1C1 = "=Sum(rc1:rc[-1])"
        End With
    End With
End Sub

As to the transfer, if it is within the same workbook, why not just continue to use the worksheet you already have? (I guess this means that I'm not sure what you're trying to do.)

 

[Yongle]

Similar but different
Corrected version

Sub WorkWithSheet()
    Dim a As Range
    With ActiveSheet
        Set a = .Range("A1").CurrentRegion
        .Cells(2, a.Columns.Count + 1).Resize(a.Rows.Count - 1).Formula = "=SUM(" & a.Resize(1, a.Columns.Count - 1).Offset(1, 1).Address(0, 0) & ")"
        .Cells(a.Rows.Count + 1, 2).Resize(, a.Columns.Count - 1) = "=SUM(" & a.Resize(a.Rows.Count - 1, 1).Offset(1, 1).Address(0, 0) & ")"
    End With
End Sub

 

[Tigerexcel]

Thanks once again CephasOz, nice code, there are times when I have to do further analysis so I keep the original data dump around for that purpose.

Thank you Yongle for your response, love the fact that you can achieve so much with so little code.

 

[CephasOz]

Hullo again Tigerexcel. If you copy the data to a different workbook, and then run the macro on the copy, it would leave the original untouched for future use. With a helper function to determine if your different workbook was open, that would look like this:

Sub AddTotals()
    Const cstrTitle As String = "AddTotals"
    Const cstrEditedWorkbook As String = "MyEditedData.xlsm"
    Dim dblNoOfRows As Double
    Dim dblNoOfCols As Double
    Dim vmsStyle As VbMsgBoxStyle
    Dim strMessage As String
    '
    ' Copy the data to the workbook containing the edited data.
    If WorkbookIsOpen(cstrEditedWorkbook) Then
        If (ActiveWorkbook.Name = cstrEditedWorkbook) Then
            strMessage = "'" & cstrEditedWorkbook & "'" & vbCrLf & "cannot be the active workbook.  Please activate the worksheet with the new data."
            vmsStyle = vbOKOnly + vbExclamation
            MsgBox strMessage, vmsStyle, cstrTitle
        Else
            ActiveSheet.Copy Before:=Workbooks(cstrEditedWorkbook).Sheets(1)
            Workbooks(cstrEditedWorkbook).Sheets(1).Activate
            ' Add the totals formulas.
            With ActiveSheet
                dblNoOfRows = .Cells(1, 1).CurrentRegion.Rows.CountLarge
                dblNoOfCols = .Cells(1, 1).CurrentRegion.Columns.CountLarge
                With .Range(.Cells(dblNoOfRows + 1, 1), .Cells(dblNoOfRows + 1, dblNoOfCols + 1))
                    .FormulaR1C1 = "=Sum(r2c:r[-1]c)"
                End With
                With .Range(.Cells(2, dblNoOfCols + 1), .Cells(dblNoOfRows + 1, dblNoOfCols + 1))
                    .FormulaR1C1 = "=Sum(rc1:rc[-1])"
                End With
            End With
        End If
    Else
        strMessage = "'" & cstrEditedWorkbook & "'" & vbCrLf & "must be opened first."
        vmsStyle = vbOKOnly + vbExclamation
        MsgBox strMessage, vmsStyle, cstrTitle
    End If
End Sub

' Is the nominated workbook open?
Function WorkbookIsOpen(ByVal strWbk As String) As Boolean
    WorkbookIsOpen = False
    On Error Resume Next
    WorkbookIsOpen = (Workbooks(strWbk).Name <> vbNullString)
End Function

To work, it requires that:
1) You have open the workbook "MyEditedData.xlsm" (or whatever you change cstrEditedWorkbook to), but ...
2) ... the new worksheet containing the data to be totalled is the active worksheet.

 

[Tigerexcel]

Thanks so much CepHasOz that will be a terrific addition.