Change or Selection Event for NON-active-x TextBox (Shape TextBox)

[mistersend]

I've inserted a TextBox ("TextBox 1") by Menu > Insert > Text > TextBox. I've inserted a Macro on the same sheet where the TextBox is present. Here is the Macro...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'If any cell is selected
If Target.Cells.Count = 1 And IsEmpty(Target) Or Not IsEmpty(Target) Then

' TextBox minimum height will not go below 171
If ActiveSheet.Shapes("TextBox 2").Height < 171 Then Let ActiveSheet.Shapes("TextBox 2").Height = 171

' Range("A356:A375").RowHeight will change if the height of the TextBox is changed so that the TextBox will remain always between the range ("A356:A375")
Range("A356:A375").RowHeight = (ActiveSheet.Shapes("TextBox 2").Height + 10) / 20

' TextBox height is adjusted to fit exactly with the Range("A356:A375") especially in bottom
ActiveSheet.Shapes("TextBox 2").Height = Range("A356:A375").Height

End If
End Sub

Description: I've added the Remarks with every line in the macro above to make my points clear. Let me explain here, too.

• The TextBox minimum height is fixed on 171 (Width of the TextBox is always static)
• The Text in the TextBox will be entered manually, not by any formula or macro.
• On entering any text, the TextBox is Auto Resized so that all the entered text will be clearly visible.
• As soon as any cell is selected, the Range("A356:A375") change its row height according to the height of the TextBox
• Then, the TextBox height is again adjusted to fit exactly with the Range("A356:A375").

Problem: Everytime I select a cell, the Macro is running, which affects my PC performance and puts unnecessary loads on the system.
Solution I Need: The macro should run only when...

• The TextBox is selected. AND
• Any text is changed inside the textbox manually

I do not want to use Active X TextBox, Because it shows unusual behavior like shrink automatically while entering the text and also it does not allow to change the font features directly from Home Menu. (I'm using MS OFFICE PRO PLUS 2019)
Thanks in advance!

 

[Yongle]

Solution I Need: The macro should run only when...

• The TextBox is selected. AND
• Any text is changed inside the textbox manually

Selection_Change event macro is only triggered when a cell is selected
A standard event macro which would trigger when the text in a simple textbox is changed does not exist
Active-X textbox has been rejected by you

A workaround is your only solution to attain similar functionality
- you could add an empty borderless active-x label (bigger than the textbox, placed below the textbox with the textbox in the middle vertically and horizontally)
- use the label mousemove event as trigger
- trigger happens when mouse hovers above bit of label that sticks out around the textbox
- use trigger to resize the textbox before resizing the label
- include a message box to allow user option to prevent increase in size
- etc...
- adapt to suit your needs

 

[mistersend]

Thanks for the suggestion. I'll try it.

Is it possible to link the box with a cell in reverse direction, that is, the content of the cell is updated according to the content of the box?? A calculate event can be triggered for the linked cell.

 

[Yongle]

Are you thinking ... amend the textbox ... changes linked cell ... triggers worksheet calculate ?
- no I do not think that is possible, the link operates in the other direction

I suggested the label mousemove method because
... the user does not see the label
... it is natural behaviour to drag mouse up, down, left or right after entering values in a textbox
(it is dependant on user action but the user is not aware of it!)

If you need any help with setting up the label, let me know and I will provide step by step instructions
- even if you choose not to use it for this it is a very simple way to do all kind of things and I use it repeatedly

Another option would be to identify either one or several cells (eg every cell adjacent to textbox in each direction) and then use either Selection_Change, Before_RightClick or Before_DoubleClick to trigger textbox resize
- user would edit the textbox and then perform one of the 3 actions
- it is not quite as automatic as it requires the user to click in some way (but it is not onerous)
- I would force textbox resize Before_Save

 

[Jaafar Tribak]

Shape TextBoxes expose no change or selection_change events like Yongle said.

You can fake a rudimentary change event with some vba trickery as follows :

Code goes in the ThisWorkbook Module:

Option Explicit

Private WithEvents cmbrs As CommandBars
Private oTextBox As Shape


Private Sub Workbook_Activate()
     EnableTextBoxChangeEvent(Sheet1.Shapes("TextBox 1")) = True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
     EnableTextBoxChangeEvent(Sheet1.Shapes("TextBox 1")) = True
End Sub

Private Sub Workbook_Deactivate()
     EnableTextBoxChangeEvent(Sheet1.Shapes("TextBox 1")) = False
End Sub

Private Property Let EnableTextBoxChangeEvent(ByVal TextBox As Shape, ByVal EnableEvent As Boolean)

    If EnableEvent Then
        Set oTextBox = TextBox
        Set cmbrs = Application.CommandBars
        Call cmbrs_OnUpdate
    Else
        Set cmbrs = Nothing
    End If

End Property

Private Sub cmbrs_OnUpdate()

    Static sText As String
    Static oPrev As Object
  
    If InStr(1, "RangeNothing", TypeName(Selection)) = 0 Then
        With oTextBox
            If Selection.Name = .Name Then
                If sText <> .TextFrame2.TextRange.Text And TypeName(oPrev) = "TextBox" Then
                    Call TextBoxFakeChangeEvent(oTextBox)
                End If
            End If
            sText = .TextFrame2.TextRange.Text
        End With
    End If
    
    Set oPrev = Selection

End Sub



'___________________________________FAKE EVENT HANDLER_________________________________________

Private Sub TextBoxFakeChangeEvent(ByVal TextBox As Shape)

    Debug.Print TextBox.TextFrame2.TextRange.Text
    
    'RUN YOUR CODE HERE ...

End Sub

 

[mistersend]

Thanks both of you for the help!!

Actually I'm new to the VBA and I don't want to make the task more complex, because -
- I don't have enough knowledge to work with any complex VBA. (Even to understand one, I've to do many searches over internet)
- I have 150 sheets, and each sheet contains 7 textbox. So, for 150x7 boxes, it'll be very difficult for me to manage the macros manually for each boxes.

------------------------------------------------------------------------------------------------------------------------------------------------------------------------

One idea which hits my mind is -

Is it possible to run the Worksheet_SelectionChange event only once (1 time) after lefting the textbox, means, after typing anything in the textbox, when I left the textbox and select any cell, the macro will run once. And then the macro will not run on selecting any cell. Again, after typing something in the textbox, when I select any cell, the macro will run once and stop.

Is there anything like...call once or anything else. I think, it'll be more simple solution, if it's possible.

 

[mistersend]

Selection_Change event macro is only triggered when a cell is selected
A standard event macro which would trigger when the text in a simple textbox is changed does not exist
Active-X textbox has been rejected by you

A workaround is your only solution to attain similar functionality
- you could add an empty borderless active-x label (bigger than the textbox, placed below the textbox with the textbox in the middle vertically and horizontally)
- use the label mousemove event as trigger
- trigger happens when mouse hovers above bit of label that sticks out around the textbox
- use trigger to resize the textbox before resizing the label
- include a message box to allow user option to prevent increase in size
- etc...
- adapt to suit your needs

Thank you for this nice idea! This solution is really very good and amazing. I have changed the vba a little bit, and it works.

Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)


' TextBox minimum height will not go below 171
  If ActiveSheet.Shapes("TextBox 2").Height < 171 Then Let ActiveSheet.Shapes("TextBox 2").Height = 171
  
' Range("A356:A375").RowHeight will change if the height of the TextBox is changed so that the TextBox will remain always between the range ("A356:A375")
  Range("A356:A375").RowHeight = (ActiveSheet.Shapes("TextBox 2").Height + 10) / 20
  
' TextBox height is adjusted to fit exactly with the Range("A356:A375") especially in bottom
  ActiveSheet.Shapes("TextBox 2").Height = Range("A356:A375").Height
  
 'Resize the label as per the height of the textbox
  ActiveSheet.Image1.Height = ActiveSheet.Shapes("TextBox 2").Height + 30


End Sub

However, there are 2 problems I'm facing with this macro -

1. The textbox is set to auto resize while entering the text. Hence If long paragraph is entered, the textbox height is increased downward accordingly and crossed the bottom line of the label edge. Now, naturally, moving the mouse downward will not trigger the mouse move event. So, the event is useless for one side (bottom side) after entering a couple of lines. (image 1)

2. If the mouse is clicked on anywhere on the label, the color of the label turns grey and the mouse pointer turns into a rotating circle in blue color, which generally appears when the pc is in some task. (image 2)

Is there any solution for these 2 cases??