Copy Cells Based on Criteria in VBA
 

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.

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.

Copy Cells Based on Criteria in VBA
 

Joel -
Thanks for the quick reply, but there's just one issue. The data in B2:B4 is
cleared right after the .FormulaR1C1 = " " line of code runs so there is
nothing that is pasted. Any ideas what could be wrong?

bugsyb6


"Joel" wrote:

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.

Copy Cells Based on Criteria in VBA
 

try this instead. I don't think you want to put a space in the blank cells.

Sub MoveComments()

LastRow = Range("A" & Rows.Count).end(xlup).Row

with Range("B2:B4").SpecialCells(xlCellTypeBlanks)

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:

Joel -
Thanks for the quick reply, but there's just one issue. The data in B2:B4 is
cleared right after the .FormulaR1C1 = " " line of code runs so there is
nothing that is pasted. Any ideas what could be wrong?

bugsyb6


"Joel" wrote:

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.