'How to copy a column value if condition is met in cell to the left
I currently have code that inserts two columns, and copies values from two other columns into these two new columns.
'Insert 2 Column to the Left of S
Columns("S:T").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeft
'Copy Column J into Column S
Columns("J:J").Select
Selection.Copy
Columns("S:S").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlFormats
'Copy Column Q into Column T
Columns("Q:Q").Select
Selection.Copy
Columns("T:T").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlFormats
However, I want to change it so that the value in Column J is only copied IF the value next to it in Column I is not "DoNotCopy" (or another specific text).
I know, as a workaround, I could insert another column and have an IF statement to only show the value if blah blah... and copy that column value over instead. But this is not as "pretty" as VBA doing the work. Or would you disagree, and this is the better way to do it?
Solution 1:[1]
Insert Column and Copy Conditionally to It
Sub InsertData()
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim rg As Range: Set rg = ws.UsedRange
With Intersect(rg.EntireRow, ws.Columns("S:T"))
.Insert Shift:=xlShiftToRight, CopyOrigin:=xlFormatFromLeftOrAbove
' Formats
Intersect(rg, ws.Columns("J")).Copy
.Columns(1).Offset(, -2).PasteSpecial xlPasteFormats
' Values
.Columns(1).Offset(, -2).Value = ws.Evaluate("IF(" _
& Intersect(rg, ws.Columns("I")).Address & "<>""DoNotCopy""," _
& Intersect(rg, ws.Columns("J")).Address & ","""")")
' Formats
Intersect(rg, ws.Columns("Q")).Copy
.Columns(2).Offset(, -2).PasteSpecial xlPasteFormats
' Values
.Columns(2).Offset(, -2).Value = Intersect(rg, ws.Columns("Q")).Value
Application.CutCopyMode = False
End With
End Sub
Solution 2:[2]
Place the IF function into your target column. This logic assumes the first row is the beginning of the data, adjust as needed.
Dim r As Range, idx As Long
'identify the last cell with a value
idx = Cells(Rows.Count, "S").End(xlUp).Row
'set the range to the target column
Set r = Range("J1:J" & idx)
'value the target column with the IF function
Cells(1, "J").Formula = "=IF(T1=""DoNotCopy"","""",S1)"
r.FillDown
r.copy
r.PasteSpecial xlPasteValues
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
Solution | Source |
---|---|
Solution 1 | VBasic2008 |
Solution 2 | igittr |