Looking to create a macro that copies text from a textbox and pastes to the cell below

willow-mouse

New Member
Joined
Aug 25, 2010
Messages
17
Background:
I have a number of Excel visual schedules that are effectively a grid with horizontal swimlanes and vertical 'week commencing' dates.
On this has been placed a number (hundreds) of text boxes that indicate a task milestone.

I want to move this to another system that is better suited to this application, but having spent 10 minutes doing the following I'm about to lose my mind:
- Individually selecting each text box
- Selecting all the text
- Copying the text
- Deselecting the text box
- Selecting the cell directly underneath
- Pasting it in to the cell
- Deleting the text box

I've had a look around and there are bits of code that seem to do bits of this but I can't link it together with my limited knowledge:

Can anyone advise? I'd like something that can either do this individually or en-masse to get all this information into a usable state for me.
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Please test on a copy first !!! Might require some tweaking according to where the TextBox is.

I have intentionally commented the 2 lines, uncomment after checking debug.print results.

VBA Code:
Public Sub textbox_test()

    Dim cTB As OLEObject

    For Each cTB In Worksheets("Sheet1").OLEObjects
        'Debug.Print cTB.Name, cTB.progID
        If InStr(UCase(cTB.progID), "TEXTBOX") > 0 Then
            Debug.Print "TB: " & cTB.Name, cTB.BottomRightCell.Offset(1,0).Address
            ' cTB.BottomRightCell.Offset(1, 0).Value = cTB.Object.Text
            ' cTB.Delete
        End If

    Next cTB
    
End Sub
 
Upvote 0
Please test on a copy first !!! Might require some tweaking according to where the TextBox is.

I have intentionally commented the 2 lines, uncomment after checking debug.print results.

VBA Code:
Public Sub textbox_test()

    Dim cTB As OLEObject

    For Each cTB In Worksheets("Sheet1").OLEObjects
        'Debug.Print cTB.Name, cTB.progID
        If InStr(UCase(cTB.progID), "TEXTBOX") > 0 Then
            Debug.Print "TB: " & cTB.Name, cTB.BottomRightCell.Offset(1,0).Address
            ' cTB.BottomRightCell.Offset(1, 0).Value = cTB.Object.Text
            ' cTB.Delete
        End If

    Next cTB
   
End Sub
Thank you - I've given this a shot and it's not working in the first instance but I'll give it another go tomorrow and let you know how I get on.
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,213
Members
448,554
Latest member
Gleisner2

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