Table's rows and/or columns expand based on cell value

[excelakos]

Hi there. I need to do this.
After i have created a table i need to be able to change its rows based on a value in another cell.
I need to type 10 in that cell and table gets 10 rows...
The same with columns.

Is it possible?Even with some vba where i refer specific to the table through its "name" and the specific cells where i input number values?


Thank you

 

[excelakos]

the total row causes problems with the calculation of the table size so the delete data outside of the table did not work. To get around this i delete the table row and add it back in. The problem is if you decrease the number of columns and a column that the code wants to do a calculation on is deleted then you will get an error. If the columns you are doing calculations on will never be deleted then this will work.

private sub worksheet_change(byval target as range)

if not intersect(target, range("a2")) is nothing or not intersect(target, range("b2")) is nothing then


    application.enableevents = false


    dim rng as range
    dim rcount as long
    dim ccount as long
    dim otable as range
        
    
    rcount = range("a2") + 1
    ccount = range("b2")
    if activesheet.listobjects("table").showtotals then
        activesheet.listobjects("table").totalsrowrange.delete
    end if
    set otable = range("table" & "[#all]")
    
    'note that the row count includes the header so if you enter 10 you will have 9 rows in the data area and the header row makes 10
    'if you want you can add one to the row count rcount = range("l2")+1 so that it gives you that number of rows in the data area
    'this just resizes the table the data will still be there.
    
    Set rng = range("table" & "[#all]").resize(rcount, ccount)
    activesheet.listobjects("table").resize rng


    if otable.rows.count > rng.rows.count then
        range(cells(rng.row + rng.rows.count, rng.column), cells(otable.row + otable.rows.count, rng.column + rng.columns.count)).clearcontents
    end if
    if otable.columns.count > rng.columns.count then
        range(cells(rng.row, rng.column + rng.columns.count), cells(otable.row + otable.rows.count, otable.column + otable.columns.count)).clearcontents
    end if
    activesheet.listobjects("table").showtotals = true
    with activesheet.listobjects("table")
        .listcolumns("headerb").totalscalculation = xltotalscalculationsum 'change headerb to your column header.
        'repeate the above with other column headers and change the calculations as need for example  xltotalscalculationcount to count
    end with
    
    application.enableevents = true
end if
end sub

thank you once again!!!!!!

 

[excelakos]

The total row causes problems with the calculation of the table size so the delete data outside of the table did not work. To get around this I delete the table row and add it back in. The problem is if you decrease the number of columns and a column that the code wants to do a calculation on is deleted then you will get an error. If the columns you are doing calculations on will never be deleted then this will work.

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("A2")) Is Nothing Or Not Intersect(Target, Range("B2")) Is Nothing Then


    Application.EnableEvents = False


    Dim rng As Range
    Dim rcount As Long
    Dim ccount As Long
    Dim otable As Range
        
    
    rcount = Range("A2") + 1
    ccount = Range("B2")
    If ActiveSheet.ListObjects("Table").ShowTotals Then
        ActiveSheet.ListObjects("Table").TotalsRowRange.Delete
    End If
    Set otable = Range("Table" & "[#All]")
    
    'NOTE that the row count includes the header so if you enter 10 you will have 9 rows in the data area and the header row makes 10
    'If you want you can add one to the row count rcount = Range("L2")+1 so that it gives you that number of rows in the data area
    'this just resizes the table the data will still be there.
    
    Set rng = Range("Table" & "[#All]").Resize(rcount, ccount)
    ActiveSheet.ListObjects("Table").Resize rng


    If otable.Rows.Count > rng.Rows.Count Then
        Range(Cells(rng.Row + rng.Rows.Count, rng.Column), Cells(otable.Row + otable.Rows.Count, rng.Column + rng.Columns.Count)).ClearContents
    End If
    If otable.Columns.Count > rng.Columns.Count Then
        Range(Cells(rng.Row, rng.Column + rng.Columns.Count), Cells(otable.Row + otable.Rows.Count, otable.Column + otable.Columns.Count)).ClearContents
    End If
    ActiveSheet.ListObjects("Table").ShowTotals = True
    With ActiveSheet.ListObjects("Table")
        .ListColumns("headerB").TotalsCalculation = xlTotalsCalculationSum 'change headerB to your column header.
        'Repeate the above with other column headers and change the calculations as need for example  [COLOR=#333333][I]xlTotalsCalculationCount to count[/I][/COLOR]
    End With
    
    Application.EnableEvents = True
End If
End Sub

I dont know exactly the reason but there is something in my workbook and from time to time it jams the code's functionality.
Could you transform it to a Sub that could be applied to button so i can run it by clicking a button?

 

[Scott T]

Sub sizetable()

    Dim rng As Range
    Dim rcount As Long
    Dim ccount As Long
    Dim otable As Range
        
    
    rcount = Range("A2") + 1
    ccount = Range("B2")
    If ActiveSheet.ListObjects("Table").ShowTotals Then
        ActiveSheet.ListObjects("Table").TotalsRowRange.Delete
    End If
    Set otable = Range("Table" & "[#All]")
    
    'NOTE that the row count includes the header so if you enter 10 you will have 9 rows in the data area and the header row makes 10
    'If you want you can add one to the row count rcount = Range("L2")+1 so that it gives you that number of rows in the data area
    'this just resizes the table the data will still be there.
    
    Set rng = Range("Table" & "[#All]").Resize(rcount, ccount)
    ActiveSheet.ListObjects("Table").Resize rng




    If otable.Rows.Count > rng.Rows.Count Then
        Range(Cells(rng.Row + rng.Rows.Count, rng.Column), Cells(otable.Row + otable.Rows.Count, rng.Column + rng.Columns.Count)).ClearContents
    End If
    If otable.Columns.Count > rng.Columns.Count Then
        Range(Cells(rng.Row, rng.Column + rng.Columns.Count), Cells(otable.Row + otable.Rows.Count, otable.Column + otable.Columns.Count)).ClearContents
    End If
    ActiveSheet.ListObjects("Table").ShowTotals = True
    With ActiveSheet.ListObjects("Table")
        .ListColumns("headerB").TotalsCalculation = xlTotalsCalculationSum 'change headerB to your column header.
        'Repeate the above with other column headers and change the calculations as need for example  xlTotalsCalculationCount to count
    End With
    
End Sub

 

[excelakos]

Dear Scott

I wish i find you well

I come back to this thread to ask about some specific functions i have in total rows in one of my files and i am not sure how i must "translate" them to fit into the code in the part about filling total rows functions. Below are the functions existing in the specified columns totals rows:

=SUBTOTAL(109;[Cost (Units)])
{=SUM(1/COUNTIF([Group];[Group]))}
=1-SUBTOTAL(109;[Biased Remainer Splitter])

 

[John AMH]

Scott, this was really helpful!
Any suggestions to make it work for multiple tables in the same sheet? Or to move data below the table if the number of rows expands?