activate macro by values in a column

[BrianW]

Hi there
I have a macro that fomats columns in an active row. In column "R" I have a
formula that returns the value of 2 if the condition is true. I want to write
a macro that will find the 2(s) in column R and run my formating macro.

Heres my formatting macro
'Range("C" & ActiveCell.Row, ActiveCell.Offset(0, 10)).Select
'Let r = ActiveCell.Row
Range("C" & ActiveCell.Row & ":M" & ActiveCell.Row).Select
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 3
Selection.Font.Bold = True
Range("R" & ActiveCell.Row).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("H" & ActiveCell.Row).Select
Selection.ClearContents
Thanks for your time

 

[broro183]

Hi Brian,

Use the macro recorder when filtering for 2's (using the autofilter)
selecting the visible cells, & removing the filter (w/o changing th
selection), and then adapt this to fit your needs.

Depending on how you adapt the recorded code for the above actions yo
should be able to remove the "activecell" references & replace the
with "selection.offset...".

If this macro is to be used repeatedly with varying amounts of data,
VBA function that checks on visible filtered rows may be useful, see:
http://www.excelforum.com/showpost.php?p=1478534&postcount=3


Hope this helps,
Rob Brockett
NZ
Always learning & the best way to learn is to experience..

 

[BrianW]

Hello fellow Kiwi
What part of the country are you from. I reside in West-AK
I should have explain more. I'm just starting to try and get my head around
VBA for excel. Having had a minor stroke a few years ago doesn't help the
brain department very well.

I have a macro that first filters the 2's as you suggested and I have the
macro for formatting the cells from column C-M of the active row, but after
I've filtered the 2's I have to select each row manually and then activate
the formating macro with hot key''s. It's this function I'm wanting to
automate.

Since posting my request for help I have read through the help in VBA and so
far have come up with the following code which works to some degree. I don't
fully understand it but I'm slowly getting my head around it. Not sure what
the abs stands for. It was in the example that I tested and it worked fine so
I just copied it over and played around till I got it to work.

Sub ItemsToPrice()
For Counter = 1 To 300
Set curCell = Worksheets("Sheet1").Cells(Counter, 18)
If Abs(curCell.Value) = 2 Then curCell.Select
Range("C" & ActiveCell.Row & ":M" & ActiveCell.Row).Select
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 3
Selection.Font.Bold = True
Range("R" & ActiveCell.Row).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("H" & ActiveCell.Row).Select
Selection.ClearContents
Next Counter

End Sub

This does work fine other than the activecell is the first row to be
formated regardless of there being a 2 in the R column

Cheers
Brian
AK-NZ

 

[broro183]

Hi Brian,
I'm based in the 'Naki at the moment & have been enjoying the long
weekend
Hopefully the macro below does everything you want (I'm sure there are
ways of tidying it up but it should work as is - provided the line
breaks are all in the right place when you copy it).
fyi, I adapted the principles of using multiple ranges from
"CopyMultipleSelection", a macro written by John Walkenbach - an Excel
guru - which I downloaded in a file called "copymult.xls".

The macro below relies on the headers being in row 2 & the first row of
data being row 3.
btw, the "abs" means that it selects any of the cells that have an
absolute value of 2 ie it could = "-2" or "2". If this is what you want
to happen, change the first line of code from:
Range("a2:r" & Application.CountA(Range("r2:R" &
(Rows.Count)))).AutoFilter Field:=18, Criteria1:="2"
to
Range("a2:r" & Application.CountA(Range("r2:R" &
(Rows.Count)))).AutoFilter Field:=18, Criteria1:="=2", Operator:=xlOr,
_
Criteria2:="=-2"



Code:
--------------------
Sub ModifiedItemsToPrice()
application.screenupdating = false
'To filter for rows with "2" in col R, select the area in col C to M for each of these rows 7 remove the autofilter
Range("a2:r" & Application.CountA(Range("r2:R" & (Rows.Count)))).AutoFilter Field:=18, Criteria1:="2"
On Error GoTo NoTwosFound
Range("c3:m" & Application.CountA(Range("r2:R" & (Rows.Count)))).SpecialCells(xlCellTypeVisible).Select
On Error GoTo 0
Selection.AutoFilter
'*
Dim SelAreas() As Range
Dim NumAreas As Integer, i As Integer
' Store the areas as separate Range objects
NumAreas = Selection.Areas.Count
ReDim SelAreas(1 To NumAreas)
For i = 1 To NumAreas
Set SelAreas(i) = Selection.Areas(i)
Next
' Copy and paste each area (col C to M) as values, same for col R, and clear contents of col H.
For i = 1 To NumAreas
SelAreas(i).Copy
SelAreas(i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("r" & SelAreas(i).Row & ":r" & SelAreas(i).Row + (SelAreas(i).Rows.Count - 1)).Copy
Range("r" & SelAreas(i).Row & ":r" & SelAreas(i).Row + (SelAreas(i).Rows.Count - 1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("h" & SelAreas(i).Row & ":h" & SelAreas(i).Row + (SelAreas(i).Rows.Count - 1)).ClearContents
'Format areas (col C to M)
With SelAreas(i).Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
With SelAreas(i).Font
.ColorIndex = 3
.Bold = True
End With
Next i
'*
application.screenupdating = true
Exit Sub
NoTwosFound:
Selection.AutoFilter
MsgBox "There are no cells with the value of 2 in column R - now exiting sub without making any changes."
application.screenupdating = true
End Sub
--------------------


hth
Rob Brockett
NZ
Always learning & the best way to learn is to experience...