Select multiple rows and add a value in a column
 

I use the code below to highlight the selected row on a worksheet. I want to
then put some text in a column on that row. I need to be able to select
multiple rows and perform the same task. I then run the 2nd macro to take
certain values from that row to another work sheet.
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'Highlight Selected Row if not empty
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Dim StrRow As String
Cells.FormatConditions.Delete
With Target.EntireRow
StrRow = .Address
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=counta(" & StrRow
& ")0"
.FormatConditions(1).Interior.ColorIndex = 27 'Color Yellow
Application.ScreenUpdating = True
End With
ActiveSheet.Protect
End Sub
Sub Accessories()
'
' Accessories Macro
' Macro recorded 19/5/01 by Alan McCruddden

r$ = Trim(Str(ActiveCell.Row))
Counter = 4
Do While Not Range("ToyotaQuotemaster.xls!A" & Counter).Value = ""
Counter = Counter + 1
Loop

If Counter <= 19 Then
Range("QM.xls!A" & Counter).Value = Range("B" + r$) 'Description
Range("QM.xls!B" & Counter).Value = Range("C" + r$) 'Model
Range("QM.xls!C" & Counter).Value = Range("A" + r$) 'Model
Range("QM.xls!D" & Counter).Value = Range("U" + r$) 'RRP
Range("QM.xls!G" & Counter).Value = Range("Z" + r$) 'Margin

Else
MsgBox "Too Many Items", vbExclamation, "Quotemaster"
End If

End Sub

Many thanks for any assistance
AJM1949

Select multiple rows and add a value in a column
 

So what is the question?

--
Regards,
Tom Ogilvy


"AJM1949" wrote in message
...
I use the code below to highlight the selected row on a worksheet. I want
to
then put some text in a column on that row. I need to be able to select
multiple rows and perform the same task. I then run the 2nd macro to take
certain values from that row to another work sheet.
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'Highlight Selected Row if not empty
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Dim StrRow As String
Cells.FormatConditions.Delete
With Target.EntireRow
StrRow = .Address
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=counta(" &
StrRow
& ")0"
.FormatConditions(1).Interior.ColorIndex = 27 'Color Yellow
Application.ScreenUpdating = True
End With
ActiveSheet.Protect
End Sub
Sub Accessories()
'
' Accessories Macro
' Macro recorded 19/5/01 by Alan McCruddden

r$ = Trim(Str(ActiveCell.Row))
Counter = 4
Do While Not Range("ToyotaQuotemaster.xls!A" & Counter).Value = ""
Counter = Counter + 1
Loop

If Counter <= 19 Then
Range("QM.xls!A" & Counter).Value = Range("B" + r$) 'Description
Range("QM.xls!B" & Counter).Value = Range("C" + r$) 'Model
Range("QM.xls!C" & Counter).Value = Range("A" + r$) 'Model
Range("QM.xls!D" & Counter).Value = Range("U" + r$) 'RRP
Range("QM.xls!G" & Counter).Value = Range("Z" + r$) 'Margin

Else
MsgBox "Too Many Items", vbExclamation, "Quotemaster"
End If

End Sub

Many thanks for any assistance
AJM1949

Select multiple rows and add a value in a column
 

Sorry I'm new to discussion groups. My question is 2 fold.
1. How do I put a value(Text)in a column on the selected row(same column for
multiple selections)?
2. How do I then get the second macro to run only on the rows selected?

Thanks
--
AJM1949


"Tom Ogilvy" wrote:

So what is the question?

--
Regards,
Tom Ogilvy


"AJM1949" wrote in message
...
I use the code below to highlight the selected row on a worksheet. I want
to
then put some text in a column on that row. I need to be able to select
multiple rows and perform the same task. I then run the 2nd macro to take
certain values from that row to another work sheet.
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'Highlight Selected Row if not empty
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Dim StrRow As String
Cells.FormatConditions.Delete
With Target.EntireRow
StrRow = .Address
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=counta(" &
StrRow
& ")0"
.FormatConditions(1).Interior.ColorIndex = 27 'Color Yellow
Application.ScreenUpdating = True
End With
ActiveSheet.Protect
End Sub
Sub Accessories()
'
' Accessories Macro
' Macro recorded 19/5/01 by Alan McCruddden

r$ = Trim(Str(ActiveCell.Row))
Counter = 4
Do While Not Range("ToyotaQuotemaster.xls!A" & Counter).Value = ""
Counter = Counter + 1
Loop

If Counter <= 19 Then
Range("QM.xls!A" & Counter).Value = Range("B" + r$) 'Description
Range("QM.xls!B" & Counter).Value = Range("C" + r$) 'Model
Range("QM.xls!C" & Counter).Value = Range("A" + r$) 'Model
Range("QM.xls!D" & Counter).Value = Range("U" + r$) 'RRP
Range("QM.xls!G" & Counter).Value = Range("Z" + r$) 'Margin

Else
MsgBox "Too Many Items", vbExclamation, "Quotemaster"
End If

End Sub

Many thanks for any assistance
AJM1949