A command button that copies cells

[slmi1313]

Hello All,
So what I need is the code for a command button to copy the info in specific cells, to a text box that I have created.

Lets say the cells are in sheet1 and the text box is on sheet 2. The command button will be on sheet3

Also I am copying multiple cells. so If the code can include an example with multiple cells it would be great

Thanks All.

[jasoncw]

As long as you want a line feed after each cell in the text box, this should work:

Private Sub CommandButton1_Click()
    Dim Rng As Range, Cell As Range
    Dim Str As String
    
    Set Rng = Sheets("Sheet1").Range("A1:D4")
    
    For Each Cell In Rng
        Str = Str & Cell & Chr(10)
    Next Cell
    Str = Left(Str, Len(Str) - 1)
    
    With Sheets("Sheet2")
        .Activate
        .Shapes(1).Select
    End With
    Selection.Text = Str
End Sub

You will need to name the sheets and range as noted in green above. You may also need to change the index number of the shape (text box).


HTH

Jason

[slmi1313]

So this what I wrote as a code and I get a run time error 438 on the last line "Selection.Text = Str" the error says Object doesn't support this property or method.

Sheet Calculator is where I want to get the cells copied
Sheet Parrs is where the textbox is(which is called TextBox1) and where I want the info from cell E3, E4 and E5 copied to. Any other ideas?

Private Sub CommandButton30_Click()
    Dim Rng As Range, Cell As Range
    Dim Str As String
    
    Set Rng = Sheets("Calculator").Range("E5:E3:E4")
    
    For Each Cell In Rng
        Str = Str & Cell & Chr(10)
    Next Cell
    Str = Left(Str, Len(Str) - 1)
    
    With Sheets("Parrs")
        .Activate
        .Shapes(1).Select
    End With
    
End Sub

[jasoncw]

First, change:

Range("E5:E3:E4")

to:

Range("E3:E5")

Next, try changing:

.Shapes(1).Select

to:

.Shapes("Text Box 1").Select

HTH

Jason

[slmi1313]

I still get the same error

[jasoncw]

Any chance you can post up a copy of your workbook?

[slmi1313]

Im getting an error from the site when I try to upload it

[jasoncw]

Try zipping it first, then post the zip file.

[slmi1313]

Here you go thanks a million

[jasoncw]

Ah. The text box is from the Controls tool bar. Try this:

Private Sub CommandButton30_Click()
    Dim Rng As Range, Cell As Range
    Dim Str As String
    
    Set Rng = Sheets("Calculator").Range("E3:E5")
    
    For Each Cell In Rng
        Str = Str & Cell & Chr(10)
    Next Cell
    Str = Left(Str, Len(Str) - 1)
    
    Sheets("Parrs").TextBox1 = Str
End Sub

HTH

Jason

[slmi1313]

that works great, the only thing that happens is that when it copies the info in the text box, they are not in line, there pasted verticaly not horizontaly. I need it to paste it like a sentence . can you help with that?

[VBA Noob]

Change

Str = Str & Cell & Chr(10)

to

 Str = Str & Cell & ", "

VBA Noob

[slmi1313]

Awesome you guys rock

[slmi1313]

Oh actually what happens now is that if there is stuff written in the text box, it erases them, is there any way to fix that

[VBA Noob]

Maybe change

Sheets("Parrs").TextBox1 = Str

to

With Sheets("Parrs").TextBox1
      .Text = .Value & Str
End With

VBA Noob

[jasoncw]

Try changing:

Sheets("Parrs").TextBox1 = Str

to:

Sheets("Parrs").TextBox1
    .Value = .Value & Str
End With

Jason

[slmi1313]

So this is the code that works perfectly. If I would need to copy cells H3:H6 and I3:I6 how would I write that in. I tried "&", I tried .Range("I3:I6") and I always get an error. Any Ideas?

Dim Rng As Range, Cell As Range
    Dim Str As String
    
    Set Rng = Sheets("Calculator").Range("H3:H6")

    For Each Cell In Rng
        Str = Str & Cell & ", "
    Next Cell
    Str = Left(Str, Len(Str) - 1)
    
    With Sheets("Parrs").TextBox1
      .Text = .Value & Str
End With

[jasoncw]

If you changed:

.Range("H3:H6")

to:

.Range("H3:I6")

The text box will include H3, I3, H4, I4, etc. Does that work? If not, you can use:

    Set Rng = Sheets("Calculator").Range("H3:H6")

    For Each Cell In Rng
        Str = Str & Cell & ", "
    Next Cell

    Set Rng = Sheets("Calculator").Range("I3:I6")

    For Each Cell In Rng
        Str = Str & Cell & ", "
    Next Cell
    Str = Left(Str, Len(Str) - 2)
    
    With Sheets("Parrs").TextBox1
      .Text = .Value & Str

HTH

Jason

[slmi1313]

This code below gives me an error on the Line Str = Str & Cell & ", " Compile error argument not optional

Set Rng = Sheets("Calculator").Range("H3:H6")

    For Each Cell In Rng
        Str = Str & Cell & ", "
    Next Cell

    Set Rng = Sheets("Calculator").Range("I3:I6")

    For Each Cell In Rng
        Str = Str & Cell & ", "
    Next Cell
    Str = Left(Str, Len(Str) - 2)
    
    With Sheets("Parrs").TextBox1
      .Text = .Value & Str

Using this code is not good for me cause I need H3:H6 first then I3:I6

.Range("H3:I6")

Thanks for all the help I love this site

[jasoncw]

Are any of I3:I6 merged cells? Any chance you can post an example copy of your workbook?

[slmi1313]

I already posted a copy

[jasoncw]

Sorry for the confusion. I plugged the below code into your attached workbook, and it worked fine for me:

Private Sub CommandButton30_Click()
    Dim Rng As Range, Cell As Range
    Dim Str As String
    
    Set Rng = Sheets("Calculator").Range("H3:H6")
    
    For Each Cell In Rng
        Str = Str & Cell & Chr(10)
    Next Cell
    
    Set Rng = Sheets("Calculator").Range("I3:I6")
    
    For Each Cell In Rng
        Str = Str & Cell & Chr(10)
    Next Cell
    
    Str = Left(Str, Len(Str) - 1)
    
    With Sheets("Parrs").TextBox1
        .Value = .Value & Str
    End With
End Sub

Jason

[slmi1313]

ok I got this is the code thanks for all your help

Dim Rng As Range, Cell As Range
    Dim Str As String
 
 Set Rng = Sheets("Calculator").Range("H3:H6")

    For Each Cell In Rng
        Str = Str & Cell & ", "
    Next Cell

    Set Rng = Sheets("Calculator").Range("I3:I6")

    For Each Cell In Rng
        Str = Str & Cell & ", "
    Next Cell
    Str = Left(Str, Len(Str) - 2)
    
    With Sheets("Parrs").TextBox1
      .Text = .Value & Str
End With
End Sub

[jasoncw]

Glad you have it fixed. Please mark the thread as solved. Thanks.

Jason