View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
joel joel is offline
external usenet poster
 
Posts: 9,101
Default 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.