Copying the same Macro to multiple rows

[neild1973]

Hi, Newbie here so hope this isn't a stupid question. I have created my first Macro which provides a tick box and when pressed places a "Y" in all the 5 cells to the left. I would now like to replicate this macro in the following 100 or so rows below but other than recording 100 macro's I am lost. Please help.
The code that the macro has produced is posted below.
Sub Macro1()
'
' Macro1 Macro
'
'
Range("H10").Select
ActiveCell.FormulaR1C1 = "y"
With ActiveCell.Characters(Start:=1, Length:=1).Font
.Name = "Times New Roman"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("G10").Select
ActiveCell.FormulaR1C1 = "y"
With ActiveCell.Characters(Start:=1, Length:=1).Font
.Name = "Times New Roman"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("F10").Select
ActiveCell.FormulaR1C1 = "y"
With ActiveCell.Characters(Start:=1, Length:=1).Font
.Name = "Times New Roman"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("E10").Select
ActiveCell.FormulaR1C1 = "y"
With ActiveCell.Characters(Start:=1, Length:=1).Font
.Name = "Times New Roman"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("D10").Select
ActiveCell.FormulaR1C1 = "y"
With ActiveCell.Characters(Start:=1, Length:=1).Font
.Name = "Times New Roman"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("C10").Select
End Sub <!-- / message --><!-- BEGIN TEMPLATE: ad_showthread_firstpost_sig --><!-- END TEMPLATE: ad_showthread_firstpost_sig -->

<!-- controls -->

 

[neild1973]

Hi VOG,

Thanks for the post, unfortunately this just inserted a "Y" one cell to the right of the Form Control box?

Can I upload the Spreadsheet? thought it may help?

 

[neild1973]

Sorry That's not strictly correct, it inserts the "Y" in the last cell clicked on previous to clicking on the Form Control Button?

 

[VoG]

You need to select the cells first. Click in the first cell then hold down the CTRL button and click to select other cells. Then run the macro.

 

[jasonb75]

Maybe not of use if you already have the controls in the sheet, but I would consider something like

Private Sub worksheet_beforedoubleclick(ByVal target As Range, cancel As Boolean)
If target.Column = 7 Then '(7 = column G)
cancel = 1
With Range(ActiveCell.Offset(0, -5), ActiveCell.Offset(0, -1))
.Value = "y"
.Font.Name = "Times New Roman"
.Font.Size = 10
End With
With ActiveCell
.Value = "a"
.Font.Name = "Webdings"
.Font.Size = 12
End With
End If
End Sub

Copied into the worksheet module.

The code is set up for the "All" column as column G, it works by double clicking the cell.

 

[neild1973]

Jasonb75,<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
You are a legend, works perfectly.<o></o>
<o> </o>
Many Thanks<o></o>
Neil<o></o>