Selection

hanman453

New Member
Joined
Jul 8, 2020
Messages
6
Office Version
  1. 2019
Platform
  1. MacOS
Main Code
VBA Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Range("AI2").Value = ActiveCell.Address
Const WS_RANGE As String = "A1:AI200"

    On Error GoTo ws_exit
    Application.EnableEvents = False

    If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
        With Target
        
            Call Test
        End With
    End If

ws_exit:
    Application.EnableEvents = True
End Sub

Macro Test
VBA Code:
Sub Test()
    ActiveSheet.Shapes.Range(Array("TextBox5")).Select                          'name of your shape/textbox
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Range("AI5").Value           'cell reference you want to get text from
    
  
    'below adjusts formatting
ActiveSheet.Shapes.Range(Array("TextBox5")).Select
     Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 12
    With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
        .Solid
    End With
End Sub

Hello there! I have a code that it intended to take information from cell AI2 and put it into text box TextBox5 by running Macro "Test" whenever any cell is selected, and it works! My issue that led to my using the code was that I wasn't able to get more than 255 characters from the cell to the text box without it, but now everything crosses over!

Now, my issue is that while the macro runs and everything updates smoothely whenever a new cell is selected, the cell that is clicked it immediately deselected and the text box is selected instead. How do I keep everything working, but stop deselecting the cells and selecting the text box automatically upon clicking any cell from in A1:AI200?

Thanks so much!
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Hi,
see if this update to your Test code does what you want

VBA Code:
Sub Test()
    Dim shp As Shape
    
'name of your shape/textbox
    Set shp = ActiveSheet.Shapes("TextBox5")

    With shp.TextFrame2.TextRange
'cell reference you want to get text from
        .Characters.Text = Range("AI5").Value
        .Font.Size = 12
     With .Font.Fill
        .Visible = msoTrue
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
        .Solid
    End With
    End With
End Sub

Dave
 
Upvote 0
Hi,
see if this update to your Test code does what you want

VBA Code:
Sub Test()
    Dim shp As Shape
   
'name of your shape/textbox
    Set shp = ActiveSheet.Shapes("TextBox5")

    With shp.TextFrame2.TextRange
'cell reference you want to get text from
        .Characters.Text = Range("AI5").Value
        .Font.Size = 12
     With .Font.Fill
        .Visible = msoTrue
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
        .Solid
    End With
    End With
End Sub

Dave

That fixed everything—thank you! Would you also know how to allow me to have five concurrent versions of this text box? I tried to duplicate it myself in the code, but it doesn't seem to have worked. If you're busy though, it's totally fine—one text box working is more than enough!

Main Code
VBA Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Range("AI2").Value = ActiveCell.Address
Const WS_RANGE As String = "A1:AI200"

    On Error GoTo ws_exit
    Application.EnableEvents = False

    If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
        With Target
        
            Call Test
            Call Test1
            Call Test2
            Call Test3
            Call Test4
        End With
    End If

ws_exit:
    Application.EnableEvents = True
End Sub

Macro Code
VBA Code:
Sub Test()
    Dim shp As Shape
    
'name of your shape/textbox
    Set shp = ActiveSheet.Shapes("TextBox5")

    With shp.TextFrame2.TextRange
'cell reference you want to get text from
        .Characters.Text = Range("AI5").Value
        .Font.Size = 12
     With .Font.Fill
        .Visible = msoTrue
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
        .Solid
    End With
    End With
End Sub
Sub Test1()
    Dim shp As Shape
    
'name of your shape/textbox
    Set shp = ActiveSheet.Shapes("TextBox6")

    With shp.TextFrame2.TextRange
'cell reference you want to get text from
        .Characters.Text = Range("AI5").Value
        .Font.Size = 12
     With .Font.Fill
        .Visible = msoTrue
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
        .Solid
    End With
    End With
End Sub
Sub Test2()
    Dim shp As Shape
    
'name of your shape/textbox
    Set shp = ActiveSheet.Shapes("TextBox7")

    With shp.TextFrame2.TextRange
'cell reference you want to get text from
        .Characters.Text = Range("AI5").Value
        .Font.Size = 12
     With .Font.Fill
        .Visible = msoTrue
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
        .Solid
    End With
    End With
End Sub
Sub Test3()
    Dim shp As Shape
    
'name of your shape/textbox
    Set shp = ActiveSheet.Shapes("TextBox8")

    With shp.TextFrame2.TextRange
'cell reference you want to get text from
        .Characters.Text = Range("AI5").Value
        .Font.Size = 12
     With .Font.Fill
        .Visible = msoTrue
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
        .Solid
    End With
    End With
End Sub
Sub Test4()
    Dim shp As Shape
    
'name of your shape/textbox
    Set shp = ActiveSheet.Shapes("TextBox9")

    With shp.TextFrame2.TextRange
'cell reference you want to get text from
        .Characters.Text = Range("AI5").Value
        .Font.Size = 12
     With .Font.Fill
        .Visible = msoTrue
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
        .Solid
    End With
    End With
End Sub
 
Upvote 0
Hi,
untested but try following update to your code

VBA Code:
Sub Test()
    Dim shp As Object, objRange As Object
    Dim arrshapes() As Variant
    
'names of your shape/textbox
    arrshapes = Array("TextBox5", "TextBox6", "TextBox7", "TextBox8", "TextBox9")

    Set objRange = ActiveSheet.Shapes.Range(arrshapes)

    For Each shp In objRange
    With shp.TextFrame2.TextRange
'cell reference you want to get text from
        .Characters.Text = Range("AI5").Value
        .Font.Size = 12
     With .Font.Fill
        .Visible = msoTrue
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
        .Solid
    End With
    End With
   Next shp
End Sub

Dave
 
Upvote 0

Forum statistics

Threads
1,213,513
Messages
6,114,072
Members
448,546
Latest member
KH Consulting

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top