VBA to copy User selection to next empty row(Column B)

[cooper645]

Below is the code i have that works for me with no problems at the moment,

the green comments are a description of what the macro should be doing

the red text is the code which needs revising
AND
the blue text is what i am trying to achieve rather than the red text

If you need anymore information, i can happily supply it.

Sub Renew()


[COLOR=#008000]' Take User Selected Cells[/COLOR]
[COLOR=#008000]' Strike them through and copy them[/COLOR]
[COLOR=#008000]' Paste them into the next empty row in column B[/COLOR]
[COLOR=#008000]' Un strike them through[/COLOR]
[COLOR=#008000]' Put the current date in the first cell in the datas new range in Column F[/COLOR]
[COLOR=#008000]' Auto fill that date down the new range of data[/COLOR]

Dim myRange As Range
Set myRange = Selection


    myRange.Select
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Strikethrough = True
    End With
    
    Selection.Copy
    [COLOR=#ff0000]Range("B29").Select[/COLOR][COLOR=#0000ff] 'Need to change this to find next empty row in Column B (Column A has Serial values already)[/COLOR]
    ActiveSheet.Paste
    
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Strikethrough = False
    End With
    
    [COLOR=#ff0000]Range("F29").Select[/COLOR][COLOR=#0000ff] 'This should select the F cell in the new datas pasted range[/COLOR]
    [COLOR=#ff0000]ActiveCell.FormulaR1C1 = "8/28/2015"[/COLOR] [COLOR=#0000ff]'This should insert date the macro was run on[/COLOR]
    [COLOR=#ff0000]Selection.AutoFill Destination:=Range("F29:F49"), Type:=xlFillCopy[/COLOR] [COLOR=#0000ff]'This should autofill only the new range of copied data[/COLOR]


End Sub

Thanks in advance
Coops

Edit; I'm using Excel 2010, Win 7 (if that makes a difference)

 

[MateusT]

Hello,

I don't think that i quite get what you want for the last part, but for the first two:

Sub Renew()




' Take User Selected Cells
' Strike them through and copy them
' Paste them into the next empty row in column B
' Un strike them through
' Put the current date in the first cell in the datas new range in Column F
' Auto fill that date down the new range of data


Dim myRange As Range
Dim rngB As Range


Set myRange = Selection




    myRange.Select
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Strikethrough = True
    End With
    
    myRange.Copy
    Set rngB = Cells(Rows.Count, "b").End(xlUp).Offset(1, 0)
    rngB.Select
    ActiveSheet.Paste
    
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Strikethrough = False
    End With
    
    rngB.Offset(0, 4) = Date
    [COLOR=#ff0000]Selection.AutoFill Destination:=Range("F29:F49"), Type:=xlFillCopy[/COLOR][COLOR=#0000ff] 'This should autofill only the new range of copied data[/COLOR]

End Sub

 

[cooper645]

That is awesome, exactly what i was after,
with regards to the last part;

your code here;

rngB.Offset(0, 4) = Date

puts the date in the first cell of column F, of the new pasted datas range perfectly,

then i want this code below;

[COLOR=#ff0000]Selection.AutoFill Destination:=Range("F29:F49"), Type:=xlFillCopy[/COLOR][COLOR=#0000ff] 'This should autofill only the new range of copied data
[/COLOR]

to copy that date down the new pasted datas column F (in this case 20 rows) but not always the same number of rows.

 

[MateusT]

I need to know how do you determine the range that will receive the dates so i can set it to the code, otherwise i don't think that i can help you.
An example of what you have and what you want would be also helpfull.

 

[cooper645]

Have managed to solve the problem, my code is attached below, if you can see a way to clean it a little, i would appreciate it, but it does exactly what its meant to at the moment

Sub Renew_Veh_Data()

Application.ScreenUpdating = False


Dim myRange As Range
Dim rngB As Range
Dim myCount1 As Integer
Dim myCount2 As Integer
Dim myRw As Integer


Set myRange = Selection


    myRange.Select
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Strikethrough = True
    End With
    
    myRange.Copy
    Set rngB = Cells(Rows.Count, "b").End(xlUp).Offset(1, 0)
    rngB.Select
    ActiveSheet.Paste
         
    myCount1 = Selection.Rows.Count
         
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Strikethrough = False
    End With
    
'this section puts todays date down row F for the newly pasted cells
    
    rngB.Offset(0, 4) = Date
    rngB.Offset(0, 4).Select


    myCount2 = ActiveCell.Row
    myRw = Selection.Row
     
      Do While myRw < myCount1 + myCount2 - 1
       myRw = myRw + 1
        Selection.Copy _
         Destination:=Cells(myRw, Selection.Column)
      Loop
    
Application.ScreenUpdating = True


End Sub