How to copy a column value if condition is met in cell to the left-CodePudding

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?

CodePudding user response：

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

CodePudding user response：

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