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

 

[Scott T]

Try

Note that if you have a total row and the table resizes so that the total row is where there is data the data will move. For example if I have something in row 17 and the resized table puts the total on row 17 the data in row 17 is moved to row 16

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("L2")) Is Nothing Or Not Intersect(Target, Range("M2")) Is Nothing Or Not Intersect(Target, Range("L4")) Is Nothing Then
'Stop
    Dim rng As Range
    Dim tname As String
    Dim rcount As Long
    Dim ccount As Long
        
    tname = Range("L4")
    rcount = Range("L2")
    ccount = Range("M2")
    
    '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(tname & "[#All]").Resize(rcount, ccount)
      
    ActiveSheet.ListObjects(tname).Resize rng
End If
End Sub

 

[excelakos]

Dear Scott

Thank you very much. But i cant make it work. Could you please guide me through all replacements needed? Should i change all

Range("L4")

with

Range("Table")

In addition i notice you comment

'this just resizes the table the data will still be there.

I also need that if lets say my last row was No25 and based on criteria the resized would be 15 rows i dont wanna have the data previous in table rows to remain in plain cells. To be honest some of the colums in the table include functions which i need to be correct.
In other vba codes i have found for deleting rows i noticed later on that if i had row No25 having function reffering to another column cell in same row if i resize table to row No15 in those cells i get function still reffering to cells in row 25....

 

[Scott T]

If you want you can hard code the table name in the code the below code uses Table1. I assumed you wanted this to run automatically when the number is changed so it is a worksheet change event and must be put in the sheet where it will run. Right click on your sheet and select view code and past the code there. If you do not want to run it it can be changed to a normal sub. The numbers in the cells that have the number of rows and columns must be valid, that is the number of rows must be at least 2 one for the headers and one row of data.

Private Sub Worksheet_Change(ByVal Target As Range)If Not Intersect(Target, Range("L2")) Is Nothing Or Not Intersect(Target, Range("M2")) Is Nothing Then
    Application.EnableEvents = False
Stop
    Dim rng As Range
    Dim rcount As Long
    Dim ccount As Long
    Dim otable As Range
        
    
    rcount = Range("L2")
    ccount = Range("M2")
    Set otable = Range("table1" & "[#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("table1" & "[#All]").Resize(rcount, ccount)
    ActiveSheet.ListObjects("table1").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
    
    
    Application.EnableEvents = True
End If
End Sub

 

[excelakos]

Oh God...
I dont know how to write vba myself but i believe i know how to copy-paste it and make the easy replacemnts to fit my needs.
Still cant make it work.

Do i need to paste the code you give me exactly as i see it or should i change following part

Set otable = Range("Table" & "[#All]")
Set rng = Range("Table" & "[#All]").Resize(rcount, ccount)

with:

Set otable = Range("Table[#All]")
Set rng = Range("Table[#All]").Resize(rcount, ccount)

I have a table named "Table"
and i have set cells
A2=for rows
B2=for columns

I have paste the code in the sheets code area...
I save it. I go to Sheet1 i amend the value in cell A2 but i see nothing happening.
I have value "1" in cell B2 as i want to have just 1 column...

What do i miss???
Following the code exactly as i have it in the sheet's code area.

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
Stop
    Dim rng As Range
    Dim rcount As Long
    Dim ccount As Long
    Dim otable As Range
        
    
    rcount = Range("A2") + 1
    ccount = Range("B2")
    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
    
    
    Application.EnableEvents = True
End If
End Sub

 

[Scott T]

I left the stop in you can delete that. After that it should work.

 

[excelakos]

I left the stop in you can delete that. After that it should work.

I feel like an idiot and spend your time too.

I really dont get it. Still nothing. Does it matter that i use Excel 2007?? Does the possition of the table matter?
I cant figure out anything


Just nothing HAPPENS..NOthing at all. Not even a flash in my screen nor any error message....
The absolute nothing....


Is there any way i can upload the work book???

 

[Scott T]

If the code did not run all the way though then events may be turned off. In the VBA editor open the Immediate window you can use CTRL-G and put this in and press enter to turn events on. Then change A2 or B2 and see if it runs.

Application.EnableEvents = True

You can not post a file directly on MrExcel but you can put the file in your dropbox and post a link.

 

[excelakos]

If the code did not run all the way though then events may be turned off. In the VBA editor open the Immediate window you can use CTRL-G and put this in and press enter to turn events on. Then change A2 or B2 and see if it runs.

Application.EnableEvents = True

You can not post a file directly on MrExcel but you can put the file in your dropbox and post a link.

You are my God for today!!!

THANK YOU!!!!!!!!!!

One last thing. I played a littled bit and noticed that if i add a totals row in the table when i reduce rows data remain in the cells outside the table. Is there any workaround for this?

 

[Scott T]

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