Text box that increases in size with contents and pushes other things in the spreadsheet down

[dpaton05]

Does anyone know how to make a text box where you can type things that will increase downwards in size to fit the contents? It needs to be at the top of the document, so when it increases in size, it will push other things down.

 

[Yongle]

What type of textbox is this? (how created?)
- Insert \ Text \ TextBox
- Developer Tab \ Insert \ Form Control \ TextBox
- Developer Tab \ Insert \ Active-X Control \ TextBox

What needs "pushing down"?
- other objects? what are they?
- cell rows? what are you thinking of? increasing row 1 height to match TextBox height?

 

[dpaton05]

I was inserting the text box from the active x control but would one of the other options solve my problem?

 

[Yongle]

What needs "pushing down"?
- other objects? what are they?
- cell rows? what are you thinking of? increasing row 1 height to match TextBox height?

 

[dpaton05]

There is a table, some command buttons and a few total rows. The total rows are outside the table as rows can be added or removed from the table using the command buttons.

 

[Yongle]

So I am guessing that the textbox is located in the top left of the sheet with everything else below it needing to be moved down
- is that correct?

Is it an Excel Table (created with Insert Table)?

Which row number is the header row of the table?

Is the textbox located above the table?

To move table down what are your thoughts?
- increasing row 1 height to match TextBox height? (cannot do this if textbox is too tall)
- inserting extra rows

How tall is the textbox likely to become? (maximum expected number of rows?)

thanks

 

[Yongle]

This is a very simplistic approach - it works with everything I tested, but it may behave differently for you
- assumes that the textbox sits in row1, and does not get too tall!

Resizing the row will work but may become inconvenient as row height increases
Doing it this way avoids rereferencing issues in your command button codes
If problematic could adapt to use several rows
(eg use rows 2:11 and hide uinless required, increasing height of row 2 to maximim of 30 and then row 3 etc - again avoiding cell reference issues)

Let me know what you think


Click on Design Mode

\ right-click on the textbox \ Properties
EnterKeyBehaviour set to TRUE
MultiLine set to TRUE

\ right-click on the textbox \ View Code
Paste the 2 lines below into the change_event

Private Sub TextBox1_Change()
    With Me.Shapes("TextBox1")
        .Top = 5
        Me.Rows(1).RowHeight = .Height + 10
    End With
End Sub

If anything is problematic, all objects can be kept the same distance from bottom of textbox like this

Private Sub TextBox1_Change()
    With Me.Shapes("TextBox1")
        .Top = 5
        Me.Rows(1).RowHeight = .Height + 10
        [COLOR=#ff0000]Me.Shapes("CommandButton1").Top = .Top + .Height + 100[/COLOR]
    End With
End Sub

 

[dpaton05]

So I am guessing that the textbox is located in the top left of the sheet with everything else below it needing to be moved down
- is that correct?

Is it an Excel Table (created with Insert Table)?

Which row number is the header row of the table?

Is the textbox located above the table?

To move table down what are your thoughts?
- increasing row 1 height to match TextBox height? (cannot do this if textbox is too tall)
- inserting extra rows

How tall is the textbox likely to become? (maximum expected number of rows?)

thanks

In response to your questions, see the following link.
https://www.screencast.com/t/6Q9fI9gYl

 

[dpaton05]

This is what happened when I added the code and tried again, must have put it in the wrong spot https://www.screencast.com/t/rI5U3AYJp0N


This is all the code I have off that sheet

Private Sub TextBox1_Change()
With Me.Shapes("TextBox1")
.Top = 5
Me.Rows(9).RowHeight = .Height + 10
End With
End Sub

Private Sub cmdAddRow_Click()

ActiveSheet.Unprotect Password:="npssadmin"

Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Set tbl = ws.ListObjects("npss_quote")
'add a row at the end of the table
tbl.ListRows.Add

ActiveSheet.Protect Password:="npssadmin"
Application.EnableEvents = True
End Sub

Private Sub cmdDeleteRow_Click()

ActiveSheet.Unprotect Password:="npssadmin"

Dim ans As Long
With ActiveSheet.ListObjects("npss_quote").DataBodyRange
ans = .Rows.Count
If ans > 1 Then .Rows(ans).Delete
If ans = 1 Then .Rows(1).Cells.SpecialCells(xlCellTypeConstants).ClearContents
End With

'Selection.ListObject.ListRows(6).Delete

ActiveSheet.Protect Password:="npssadmin"
Application.EnableEvents = True
End Sub

Private Sub CommandButton2_Click()
'Modified 8/30/2018 9:24:30 PM EDT
'Dim ans As Long
'With ActiveSheet.ListObjects("npss_quote").DataBodyRange
' ans = .Rows.Count
' If ans > 1 Then .Rows(ans).Delete
' If ans = 1 Then .Rows(1).Cells.SpecialCells(xlCellTypeConstants).ClearContents
' End With
End Sub

Private Sub cmdDelRow_Click()
Rows("7:7").Select
Selection.Delete Shift:=xlUp
End Sub

Private Sub cmdDelSelect_Click()

ActiveSheet.Unprotect Password:="npssadmin"
Dim rng As Range

On Error Resume Next
With Selection.Cells(1)
Set rng = Intersect(.EntireRow, ActiveCell.ListObject.DataBodyRange)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "Please select a cell within a row that you want to delete.", vbCritical
Else
rng.Delete xlShiftUp
End If
End With
Application.EnableEvents = True
ActiveSheet.Protect Password:="npssadmin"

End Sub


Private Sub CommandButton1_Click()
Rows("7:7").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
Application.EnableEvents = False
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
If Target.Value < Date Then
ans = MsgBox("This input is older than today !....Are you sure that is what you want ???", vbYesNo)
If ans = vbNo Then Target.Value = ""
End If
End If
Application.EnableEvents = True
End Sub

Sub Reset_Me()
Application.EnableEvents = True
End Sub

 

[Yongle]

Thanks for the images - that helps

1 Are you using rows 1-4 for anything else?
2 Are you using rows 7-9 for anything else?

Which way do you want the table to expand?
1. leave the size of rows 5 and 6 unchanged, line up bottom of the box with bottom of row 6, allow the box to grow upwards altering the height of rows 3-4 (ie always fits between rows 3 and 6)
2. leave the size of rows 5 and 6 unchanged, line up the top of the box with middle of row 4, allow the box to grow downwards, altering the heights of rows 7-8 (ie always fits between rows 4 and 8)
3. leave the size of rows 5 and 6 unchanged, allow the box to grow centred on rows 5-6, altering the height of rows 3-4 and 7-8 (ie always fits between rows 3 and 8)
4. Something else???