Displaying cells with multi-line text 'elegantly'...

wabbit_47

wabbit_47

New Member
Joined
Feb 9, 2012
Messages
12
Hi Excel Gurus :rolleyes:

Like many, I'm a bit of a VBA/Macro 'Noob' but I'm hoping there might be someone out there with an 'elegant' solution to this problem for me...

I've been developing a large spreadsheet (approx 26 columns) and ongoing/infinite rows. Each row entry is filled in by a userform and entered by hitting the 'Submit' button which pastes everything from the forms textboxes, comboboxes, DTPickers, etc into the corresponding columns automatically and all is working ticketty-boo except for 3 of the columns, all with the same problem.

The troublesome three are all entered into the sheet via a textbox on the userform just like the others, only they all contain large quantities of text. I'm trying to figure out a way of displaying this text in the actual cell (after submitting the form) without altering the row height (keeping it all to an 'elegant' 15.00), but still maintaining the ability to search for text in the cells....perhaps some kind of 'hover-over' display or the like?

The macro to paste the information into the spreadsheet is triggered by a submit button on the userform that is coded as below...

Code: 
Private Sub CommandButton1_Click()
    Dim LastRow As Object
 
 
    Set LastRow = Sheet1.Range("a65536").End(xlUp)
 
    LastRow.Offset(1, 0).Value = DTPicker1.Value
    LastRow.Offset(1, 1).Value = DTPicker2.Value
    LastRow.Offset(1, 2).Value = TextBox3.Text
    LastRow.Offset(1, 3).Value = TextBox4.Text
    LastRow.Offset(1, 4).Value = TextBox5.Text
    LastRow.Offset(1, 5).Value = ComboBox7.Text
    LastRow.Offset(1, 6).Value = DTPicker3.Value
    LastRow.Offset(1, 7).Value = TextBox6.Text
    LastRow.Offset(1, 8).Value = TextBox7.Text
    LastRow.Offset(1, 9).Value = Replace(FutureMovementsForm.TextBox8.Text, vbCrLf, vbLf, 1, -1, vbTextCompare)
    Me.Hide
    LastRow.Offset(1, 10).Value = TextBox9.Text
    LastRow.Offset(1, 11).Value = TextBox10.Text
    LastRow.Offset(1, 12).Value = TextBox11.Text
    LastRow.Offset(1, 13).Value = TextBox12.Text
    LastRow.Offset(1, 14).Value = TextBox13.Text
    LastRow.Offset(1, 15).Value = TextBox14.Text
    LastRow.Offset(1, 16).Value = ComboBox1.Text
    LastRow.Offset(1, 17).Value = TextBox16.Text
    LastRow.Offset(1, 18).Value = ComboBox2.Text
    LastRow.Offset(1, 19).Value = ComboBox3.Text
    LastRow.Offset(1, 20).Value = ComboBox4.Text
    LastRow.Offset(1, 21).Value = ComboBox5.Text
    LastRow.Offset(1, 22).Value = ComboBox6.Text
    LastRow.Offset(1, 23).Value = Replace(FutureMovementsForm.TextBox22.Text, vbCrLf, vbLf, 1, -1, vbTextCompare)
    Me.Hide
    LastRow.Offset(1, 24).Value = Replace(FutureMovementsForm.TextBox23.Text, vbCrLf, vbLf, 1, -1, vbTextCompare)
    Me.Hide
    MsgBox "One record written to the shedule"
 
    response = MsgBox("Do you want to enter another record?", _
        vbYesNo)
 
    If response = vbYes Then
 
        TextBox3.Text = ""
        TextBox4.Text = ""
        TextBox5.Text = ""
        TextBox6.Text = ""
        TextBox7.Text = ""
        TextBox8.Text = ""
        TextBox9.Text = ""
        TextBox10.Text = ""
        TextBox11.Text = ""
        TextBox12.Text = ""
        TextBox13.Text = ""
        TextBox14.Text = ""
        TextBox16.Text = ""
        TextBox22.Text = ""
        TextBox23.Text = ""
        ComboBox1.Text = ""
        ComboBox2.Text = ""
        ComboBox3.Text = ""
        ComboBox4.Text = ""
        ComboBox5.Text = ""
        ComboBox6.Text = ""
        ComboBox7.Text = ""
 
 
        DTPicker1.SetFocus
 
      Else
          Unload Me
      End If
 
 
End Sub

Textboxes 8, 22 and 23 are the ones with multiple lines. The code that starts with "Replace(FutureMovementsForm...." is to prevent the square boxes with the question marks appearing in the cells.

Long-winded but hopefully detailed and specific enough that you might have a few possible solutions :)

Cheers to you in advance (y)
Wabbit_47
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Sort by date Sort by votes
Hi and Welcome to the Board,

I'm not completely following your desired result.
Are you saying that you want to have a fixed row height that will display one line of text (presumably hiding part of the "wrapped / multiline" content) but somehow allow the user to "read" the entire contents of the cell when they pass their cusor over it?

That's an interesting puzzle. Typically linefeeds (Alt-Enter) are undesirable in a dataset so I'd encourage you to avoid that.
You might consider using Worksheet Event code that would "elegantly" display the cells of the cell when triggered by Clicking or Double Clicking the Cell.

The elegant display might be temporarily increasing the row height, or displaying the contents in a Comment box.
 
Upvote 0
Interesting...this should get you started...it is worksheet based event so right click on the Sheet's Tab and choose "View Code" and then paste this:
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ws As Worksheet
Static oshp As Shape
Set ws = ActiveSheet
If Not oshp Is Nothing Then oshp.Delete
If Target.Column = 5 Then
    Set oshp = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 100, 100)
    oshp.TextFrame2.TextRange.Characters.Text = Target.Value
End If
End Sub
 
Upvote 0
Taurean, you are a rockstar!! :) Thank you very much for that...its a very elegant solution and exactly what I'm after. It keeps a neat and professional appearance, fully displays the contents of the cell and I can still search the text entries. Brilliant!

I'm needing this to happen for the cells in 4 separate columns so I'll get to work figuring out how to change the code around to allow for this. So far I've done the below...

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Unprotect
Dim ws As Worksheet
Static oshp As Shape
Set ws = ActiveSheet
If Not oshp Is Nothing Then oshp.Delete
If Target.Column = 10 Then
    Set oshp = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, 950, 5, 600, 80)
    oshp.TextFrame2.TextRange.Characters.Text = Target.Value
If Target.Column = 11 Then
    Set oshp = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, 1122, 5, 600, 80)
    oshp.TextFrame2.TextRange.Characters.Text = Target.Value
If Target.Column = 25 Then
    Set oshp = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, 2514, 5, 600, 80)
    oshp.TextFrame2.TextRange.Characters.Text = Target.Value
If Target.Column = 26 Then
    Set oshp = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, 2857, 5, 600, 80)
    oshp.TextFrame2.TextRange.Characters.Text = Target.Value
End If
End If
End If
End If
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
End Sub

I've only got it working for the first one (column 10) thus far but I shall perservere for the other 3 (columns 11, 25 and 26)...I'm sure it's probably something fairly simple that I'm overlooking :cool:

I'm getting an "object required" debugging message (with the "oshp.Delete" highlighted in the debugger) when I highlight cells in other columns ...any idea what this might be?

Again, thank you for your help! (y)
Wabbit_47
 
Upvote 0
Gudday JS411 :)

Thanks for your reply...and yes, your description of the desired result is spot-on. A hover-over or click-on solution is the desired result and Taurean's solution achieves this beautifully. However, I like your suggestion of the 'comment box' and I've actually been able to apply this to another spreadsheet project I'm working on. Thanks for the suggestion! :)

Wabbit_47
 
Upvote 0
wabbit_47 said:
I've only got it working for the first one (column 10) thus far but I shall perservere for the other 3 (columns 11, 25 and 26)...I'm sure it's probably something fairly simple that I'm overlooking :cool:

I'm getting an "object required" debugging message (with the "oshp.Delete" highlighted in the debugger) when I highlight cells in other columns ...any idea what this might be?
Again, thank you for your help! (y)
Wabbit_47
Click to expand...

Hi,

The error was due to fact that: the code was deleting previous shape which "Set" statement was still holding onto. Obviously something which I had not thought of and overlooked completely. I have commented that part in the below approach.

Hopefully, this should work as you want.
Code: 
[color=darkblue]Private[/color] [color=darkblue]Sub[/color] Worksheet_SelectionChange([color=darkblue]ByVal[/color] Target [color=darkblue]As[/color] Range)
[color=darkblue]Dim[/color] ws [color=darkblue]As[/color] Worksheet
[color=darkblue]Static[/color] oshp [color=darkblue]As[/color] Shape
[color=darkblue]Set[/color] ws = ActiveSheet

[color=darkblue]If[/color] Target.Count > 1 [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]

ActiveSheet.Unprotect

[color=green]'Only if oshp exists then delete and unset the dead reference[/color]
[color=darkblue]If[/color] [color=darkblue]Not[/color] oshp [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color] oshp.Delete: [color=darkblue]Set[/color] oshp = [color=darkblue]Nothing[/color] [color=green]'Here we unset it[/color]

[color=darkblue]If[/color] Target.Column = 10 [color=darkblue]Then[/color] [color=green]'Multiple Ifs are not needed[/color]
    [color=darkblue]Set[/color] oshp = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, 950, 5, 600, 80)
    oshp.TextFrame2.TextRange.Characters.Text = Target.Value
[color=darkblue]ElseIf[/color] Target.Column = 11 [color=darkblue]Then[/color]
    [color=darkblue]Set[/color] oshp = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, 1122, 5, 600, 80)
    oshp.TextFrame2.TextRange.Characters.Text = Target.Value
[color=darkblue]ElseIf[/color] Target.Column = 25 [color=darkblue]Then[/color]
    [color=darkblue]Set[/color] oshp = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, 2514, 5, 600, 80)
    oshp.TextFrame2.TextRange.Characters.Text = Target.Value
[color=darkblue]ElseIf[/color] Target.Column = 26 [color=darkblue]Then[/color]
    [color=darkblue]Set[/color] oshp = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, 2857, 5, 600, 80)
    oshp.TextFrame2.TextRange.Characters.Text = Target.Value
[color=darkblue]End[/color] [color=darkblue]If[/color]

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=[color=darkblue]True[/color] _
, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True

[color=darkblue]End[/color] [color=darkblue]Sub[/color]
 
Upvote 0
One day people will write songs about you :cool:

Absolutely perfect! I've spent the morning testing in all manner of conditions and everything is spot on!

Thank you heaps Taurean, that's better than I'd originally planned for.

Cheers mate!
(y)
 
Upvote 0
Would putting the text as a single line in the cell and the text with line breaks into the cell's comment work for you?
That would have to be added to the Userform's Submit button code.
 
Upvote 0
wabbit_47 said:
One day people will write songs about you :cool:

Absolutely perfect! I've spent the morning testing in all manner of conditions and everything is spot on!

Thank you heaps Taurean, that's better than I'd originally planned for.

Cheers mate!
(y)
Click to expand...
Thank you for your feedback.
 
Upvote 0
Really like the approach taken here. Props to taurean.

I can see one potential issue though. If the user saves the workbook with the shape showing, when they later reopen the workbook that shape will no longer be deleted when the cell is deselected. This is because the static variable will have been cleared.

The following code should address this issue as it does not rely on the static object. It has also been slightly modified to show the shape to the right of the selected cell.

HTH,

Joe
http://www.spreadsheetstudio.com

Code: 
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    Const SHAPENAME As String = "MessageShape"
    Dim ws As Worksheet
    Dim oshp As Shape
    Dim icount As Integer
    Dim iX As Integer
    Dim iY As Integer
    Dim iHeight As Integer
    Dim iWidth As Integer
    
    Set ws = ActiveSheet
    
    'Only run if one cell is selected
    If Target.Count > 1 Then Exit Sub
    
    'Delete any existing shapes. We run though all shapes backwards
    For icount = ws.Shapes.Count To 1 Step -1
        Set oshp = ws.Shapes(icount)
        If (oshp.Name = SHAPENAME) Then
            oshp.Delete
        End If
    Next icount
    
    'Lets grab the position of the selected cell, we'll use this to place the message box just to the right of it.
    'We add 5 to the position to give it a pleasant offset
    iX = Target.Cells(1, 2).Left + 5
    iY = Target.Top + 5
    iHeight = 60 'Adjust the box height by changing this
    iWidth = 200 'Adjust the box widthby changing this
    
    'Show the message box - Amend this if you want to change the position
    Select Case Target.Column
            Case 10, 11, 25, 26 'Add column numbers here
            Set oshp = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, iX, iY, iWidth, iHeight)
            oshp.TextFrame2.TextRange.Characters.Text = Target.Value
            oshp.Name = SHAPENAME
    End Select

End Sub
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
TextBox looping help required in VBA
Replies
3
Views
389
DanteAmor
DanteAmor
I
  • Solved
Show or Hide Textbox advice
Replies
8
Views
434
dmt32
D
P
  • Solved
Code doesn't go on a new line (emptyRow)
Replies
8
Views
233
Fluff
Fluff
B
  • Question
Populating a worksheet based on a Combo Box value within a User Form
2 3 4
Replies
35
Views
1K
igold
igold
P
  • Question
Copy data from textbox and Combobox into Listbox
Replies
1
Views
190
Patriot2879
P

Forum statistics

Threads
1,215,123
Messages
6,123,182
Members
449,090
Latest member
bes000

Share this page

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