A
AJM1949
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
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