Preventing auto filling VBA formula in next cell after COPY&PASTE

[morenac]

Hello,

I would like to ask for help with following code:

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim thisRow As Long
    If Target.Column = 5 Then
        thisRow = Target.Row
        If thisRow > 3 Then
            Target.Offset(0, -1).FormulaR1C1 = "=IF(RC[10]=""VIP"",1,IF(RC[10]=""P"",2,IF(RC[10]=""BS"",3,0)))"     'formula in column D
            Target.Offset(0, -2).FormulaR1C1 = "=RC[3]&"" ""&RC[7]"     'formula in column C
            Target.Offset(0, -3).FormulaR1C1 = "=RC[6]&"".""&VLOOKUP(RC[7],data!R2C1:R13C2,2,0)&"".""&LEFT(RC[5],3)"     'formula in column B


        End If
    End If
End Sub

This code works fine that in range B-D should appear formulas, when cell in column E is filled. There are filled also columns F-N (not valid for formula input by vba).

The problem comes, when I want to input all the data at once (copy & paste from different source) whole range E - N. In this case the formulas are created correctly in B-D columns, but are copying also to column E, F G etc.

I know that it could be disable by excel option, but file will be used by few users and I would prefer some vba prevent solution, if possible?

Thank you very much in advance.

 

[wideboydixon]

If you pasted values into, for example, E2:N2 then this is what Target would represent. Target.Offset(0, -1) is then D2:M2 so you're setting a formula for a whole range and not a single cell. Try this instead:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim thisRow As Long
    If Target.Column = 5 Then
        thisRow = Target.Row
        If thisRow > 3 Then
            Cells(thisRow, "D").FormulaR1C1 = "=IF(RC[10]=""VIP"",1,IF(RC[10]=""P"",2,IF(RC[10]=""BS"",3,0)))"     'formula in column D
            Cells(thisRow, "C").FormulaR1C1 = "=RC[3]&"" ""&RC[7]"     'formula in column C
            Cells(thisRow, "B").FormulaR1C1 = "=RC[6]&"".""&VLOOKUP(RC[7],data!R2C1:R13C2,2,0)&"".""&LEFT(RC[5],3)"     'formula in column B
        End If
    End If
    
End Sub

It's not optimal but then perhaps you didn't post all the code so I left it mostly as-is.

WBD

 

[morenac]

Hello WBD,

thank you for your reaction. There is no more code for this purpose.
The adjustment you did, works perfectly in case that user will copy only one row. Is possible to modify to work with more then 1 row selection?

Thank you very much for your effort!

 

[wideboydixon]

Untested but this should work:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim changedRange As Range
    Dim changedCell As Range
    
    Set changedRange = Application.Intersect(Target, Range("E:E"))
    If changedRange Is Nothing Then Exit Sub
    For Each changedCell In changedRange
        If changedCell.Row > 3 Then
            Cells(changedCell.Row, "D").FormulaR1C1 = "=IF(RC[10]=""VIP"",1,IF(RC[10]=""P"",2,IF(RC[10]=""BS"",3,0)))"     'formula in column D
            Cells(changedCell.Row, "C").FormulaR1C1 = "=RC[3]&"" ""&RC[7]"     'formula in column C
            Cells(changedCell.Row, "B").FormulaR1C1 = "=RC[6]&"".""&VLOOKUP(RC[7],data!R2C1:R13C2,2,0)&"".""&LEFT(RC[5],3)"     'formula in column B
        End If
    Next changedCell
    
End Sub

WBD