VBA to copy selected cell value to next empty cell in a range

[MeaclH]

Hi there,

I have a VBA that works perfectly fine for its current use, however I need it to be more specific about where it pastes the data.
I really need a code that takes the value in a selected cell, copies it to the next empty cell in the column between rows 4-8, adds cell colour fill formatting to new cell and then applies strikethrough formatting to the original selected cell.

For example
H18 is selected cell.
Value copied to next empty cell in range H4:8
Formatting for new cell fill colour #FF7C80
Strikethrough applied to value in H18

Thanks heaps for any help you may have.

Hayden

 

[Snakehips]

@MeaclH I'm assuming you want similar for more columns than just H ?

Maybe try like below.

Sub Copyandstrike()
Dim r As Integer, c As Integer

If Selection.Cells.Count > 1 Then Exit Sub

c = Selection.Column '????*No check on validity of columnn!'

For r = 4 To 8
    If Cells(r, c) = vbNullString Then
        Cells(r, c).Value = Selection.Value
        Cells(r, c).Interior.Color = RGB(100, 49, 50) 'Edit RGB values if necessary
        Selection.Font.Strikethrough = True
        r = 0
        Exit For
     End If
Next

If Not r = 0 Then MsgBox "There are no blanks left!"

End Sub

HTH

 

[MeaclH]

Tony you're the man! Thanks mate.

 

[MeaclH]

Tony you're the man! Thanks mate.

@MeaclH I'm assuming you want similar for more columns than just H ?

Maybe try like below.

Sub Copyandstrike()
Dim r As Integer, c As Integer

If Selection.Cells.Count > 1 Then Exit Sub

c = Selection.Column '????*No check on validity of columnn!'

For r = 4 To 8
    If Cells(r, c) = vbNullString Then
        Cells(r, c).Value = Selection.Value
        Cells(r, c).Interior.Color = RGB(100, 49, 50) 'Edit RGB values if necessary
        Selection.Font.Strikethrough = True
        r = 0
        Exit For
     End If
Next

If Not r = 0 Then MsgBox "There are no blanks left!"

End Sub

HTH

Tony you're the man! Thanks mate