copy data to specific cell based on user input

jamshoot

Board Regular
Joined
Oct 15, 2009
Messages
199
Hi all

I struggling to have a macro that allow me to copy data to specific cell based on user input.
Example:

I have "X" data in A2
I need a macro prompt to enable user to input how many "X" to copy & paste to cell
I am looking at the user will first have the cursor at A2 & then click a button (with macro) which prompt how many X to copy & paste.
The offset to paste is fixed, ie. in column C, E & G
Then if the User want to repeat for A3, the process is repeat as above.


A1 B1 C1 D1 E1 F1 G1 H1
A2 X X X X
A3 X X

Anyone can help me

Cheers
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Code:
myOutput = ActiveCell.Value
Dim myQuantity as Integer
myQuantity = InputBox("How many offsets")
If IsNumeric(myQuantity) = TRUE Then
    i = 1
    Do Until i > myQuantity
        ActiveCell.Offset(columnOffset:=i).Value = myOutput
        i = i + 1
    Loop
End If
I can't promise this will work. I don't ever use offset in my code and I don't even know if I can use "i" as a variable when setting the columnOffset. I just wrote this with assumptions that offset works just like most other code but that isn't always the case. Like the paste function is different than the copy function for example. I googled offset code to come up with this.
 
Upvote 0
Just a non-looping method..

Code:
Sub copycell()
    Dim myQuantity As Integer, myOutput As String
    myOutput = ActiveCell.Value
    myQuantity = Application.InputBox("type in number", Type:=1)
    If myQuantity = False Then Exit Sub
    ActiveCell.Resize(1, myQuantity + 1).Value = myOutput
End Sub
 
Upvote 0
Another looping solution

Code:
Sub Foo()
If ActiveCell.Column <> 1 Then Exit Sub
res = InputBox("How many times do you wish" & vbNewLine _
        & "to copy your activecell to the right?")
If res = vbNo Or res = "" Or Not IsNumeric(res) Then Exit Sub
For n = 2 To (res * 2) Step 2
    Cells(ActiveCell.Row, (1 + n)).Value = ActiveCell.Value
Next n
End Sub
 
Upvote 0
Looking back at the line:

If res = vbNo Or res = "" Or Not IsNumeric(res) Then Exit Sub

I acknowledge it should read:

If res = "" Or Not IsNumeric(res) Then Exit Sub

As the InputBox() doesn't give the opportunity for a "No" response.
 
Upvote 0
Wow, too many mistakes here is the FINAL.. I would hope... Jim

Code:
Sub Foo()
If ActiveCell.Column <> 1 Then Exit Sub
If ActiveCell.Value = "" Then
MsgBox "There is currently nothing in your" & vbNewLine _
    & "A column. Enter a value and try again"
    Exit Sub
End If
res = InputBox("How many times do you wish" & vbNewLine _
        & "to copy the activecell to the right?")
If res = "" Or Not IsNumeric(res) Then Exit Sub
For n = 3 To ((res * 2) + 1) Step 2
    Cells(ActiveCell.Row, n).Value = ActiveCell.Value
Next n
End Sub
 
Upvote 0
Wow, too many mistakes here is the FINAL.. I would hope... Jim

Code:
Sub Foo()
If ActiveCell.Column <> 1 Then Exit Sub
If ActiveCell.Value = "" Then
MsgBox "There is currently nothing in your" & vbNewLine _
    & "A column. Enter a value and try again"
    Exit Sub
End If
res = InputBox("How many times do you wish" & vbNewLine _
        & "to copy the activecell to the right?")
If res = "" Or Not IsNumeric(res) Then Exit Sub
For n = 3 To ((res * 2) + 1) Step 2
    Cells(ActiveCell.Row, n).Value = ActiveCell.Value
Next n
End Sub

Hi Jim

Thanks for the code but when i run the macro, nothing happened.

Cheers
 
Upvote 0
Seeing as it looks like I missed an important line in the question try the code below (unfortunately it does loop).

Code:
Sub jjjxxx()
    Dim x As Long, j As Long
    x = ActiveCell.Row
    For j = 1 To Application.InputBox("type in number", Type:=1)
        Cells(x, 1 + (j * 2)) = ActiveCell.Value
    Next
End Sub

See if this version of Jim's code runs for you (It should do if the above does)

Code:
Sub Foo()
    Dim res As String, n As Long
    If ActiveCell.Column <> 1 Then Exit Sub
    
    If ActiveCell.Value = "" Then
        MsgBox "There is currently nothing in your" & vbNewLine _
             & "A column. Enter a value and try again"
        Exit Sub
    End If
    
    res = InputBox("How many times do you wish" & vbNewLine _
                 & "to copy the activecell to the right?")
    If res = "" Or Not IsNumeric(res) Then Exit Sub
    
    For n = 3 To ((res * 2) + 1) Step 2
        Cells(ActiveCell.Row, n).Value = ActiveCell.Value
    Next n
End Sub
 
Upvote 0
Can u split your screen between your worksheet and the code window then step-thru the code (using the F8 key).
Watch what happens, or doesn't happen.
 
Upvote 0
Seeing as it looks like I missed an important line in the question try the code below (unfortunately it does loop).

Code:
Sub jjjxxx()
    Dim x As Long, j As Long
    x = ActiveCell.Row
    For j = 1 To Application.InputBox("type in number", Type:=1)
        Cells(x, 1 + (j * 2)) = ActiveCell.Value
    Next
End Sub

See if this version of Jim's code runs for you (It should do if the above does)

Code:
Sub Foo()
    Dim res As String, n As Long
    If ActiveCell.Column <> 1 Then Exit Sub
    
    If ActiveCell.Value = "" Then
        MsgBox "There is currently nothing in your" & vbNewLine _
             & "A column. Enter a value and try again"
        Exit Sub
    End If
    
    res = InputBox("How many times do you wish" & vbNewLine _
                 & "to copy the activecell to the right?")
    If res = "" Or Not IsNumeric(res) Then Exit Sub
    
    For n = 3 To ((res * 2) + 1) Step 2
        Cells(ActiveCell.Row, n).Value = ActiveCell.Value
    Next n
End Sub

Hi Jim

Thanks... it works beautifully. May Itrouble you with one question.

In A1:A50, I have formula to check each text in each cell from B1:B50 column.
If each B cell have text, it will create a increment serial number in A.
I want a macro that allow me to select only visible serial number in A column.
I try using the "Selection.End(xldown)" in A column, but it include all non appear serial number.
Can you help.

cheers
Example:
 
Upvote 0

Forum statistics

Threads
1,213,558
Messages
6,114,297
Members
448,564
Latest member
ED38

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