Copy Cells Based on Criteria in VBA
Sub MoveComments()
LastRow = Range("A" & Rows.Count).end(xlup).Row
with Range("B2:B4")
.SpecialCells(xlCellTypeBlanks).Select
.FormulaR1C1 = " "
With .Characters(Start:=1, Length:=1).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
end with
LastCol = Cells(1,Columns.Count).End(xlToLeft).Column
For rowCount = 2 to LastRow
if Range("C" & RowCount) = "Active" then
Range("B" & RowCount).Copy
cells(RowCount, LastCol + 1).PasteSpecial _
Paste:=xlPasteValues
with cells(1, LastCol + 1)
.Value = Date
.NumberFormat = "mm/dd/yy"
End With
Range("B" & RowCount).ClearContents
end if
next rowcount
Range("B2").Select
Application.CutCopyMode = False
End Sub
"bugsyb6" wrote:
I have a worksheet I'm using for tracking projects set up in a List (XL2003)
as follows:
A B C
1 Project Comments Status
2 Kaizen1 in process Active
3 CEDAC1 Active
4 CEDAC2 successful Complete
I am currently running the following code weekly to move the comments (or
lack of comments) to consecutive columns to the right of this beginning in
column F so that people can view comment history about a project but clear
the comment section for next week's input.
Sub MoveComments()
Range("B2:B4").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = " "
With Selection.Characters(Start:=1, Length:=1).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Copy
Range("B2:B4").Copy
Range("BZ2").End(xlToLeft).Offset(, 1).PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
With Range("BZ1").End(xlToLeft).Offset(, 1)
.Value = Date
.NumberFormat = "mm/dd/yy"
End With
Range("B2:B4").ClearContents
Range("B2").Select
Application.CutCopyMode = False
End Sub
What I would like it to do is to move and clear the comments only from those
rows where the "Status" is listed as "Active" and leave the comments in
column B for those that are listed as "Complete".
Any help you can provide (as well as suggestions to clean up my existing
code) is greatly appreciated.
|