Worksheet_Change help

[wrightyrx7]

Hi all,

I have a workbook that I have used for a while where I put a number in 'col A' and it does a vlookup for other details.

I had a problem where if I DELETED more than one number from 'col A', I got an error from the macro. I got around this with:-

If Target.Cells.Count > 1 Then
    Exit Sub
End If

But now I want to ADD more than one number at a time and the vlookup to run. But im guessing the about code will stop this happening.

Is there any suggestions to how i will get around this?

Thanks in advance
Chris

 

[ParamRay]

.
.

Please post the Worksheet_Change subprocedure...

 

[wrightyrx7]

Hi gpeacock,

Private Sub Worksheet_Change(ByVal Target As Excel.Range)


If Target.Cells.Count > 1 Then
    Exit Sub
End If


Application.EnableEvents = False
Application.ScreenUpdating = False


    nRow = Target.Row
    If Target.Column = 1 Then
            If Target.Value <> "" Then
                '====================================BASIC DETAILS===================================
                Range("B" & nRow).Formula = "=VLOOKUP(A" & nRow & ",'All Staff (Names)'!A:C,3,FALSE)" 'Forname
                Range("C" & nRow).Formula = "=VLOOKUP(A" & nRow & ",'All Staff (Names)'!A:C,2,FALSE)" 'Surname
            Else
                Rows(nRow).ClearContents
            End If
    End If
    
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

 

[ParamRay]

.
.

Try this instead:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    Dim WRng As Range
    Dim Cell As Range
    
    On Error Resume Next
        Set WRng = Intersect(Me.Columns("A"), Target)
    On Error GoTo 0
    
    If Not WRng Is Nothing Then
        For Each Cell In WRng
            With Cell
                If .Value <> vbNullString Then
                    .Offset(0, 1).Formula = "=VLOOKUP(" & Cell.Address & ",'All Staff (Names)'!A:C,3,FALSE)"
                    .Offset(0, 2).Formula = "=VLOOKUP(" & Cell.Address & ",'All Staff (Names)'!A:C,2,FALSE)"
                Else
                    .Offset(0, 1).ClearContents
                    .Offset(0, 2).ClearContents
                End If
            End With
        Next Cell
    End If

End Sub

 

[wrightyrx7]

Works perfect!! Thank you very much

 

[wrightyrx7]

Can I ask a quick question please.

When I step through the code (to try and learn how the code works), each time a formula is added it looks like the subroutine starts from the beginning, but then adds the second formula.

Why does it do this and not just add the next formula?

Regards
Chris

 

[ParamRay]

Can I ask a quick question please.

When I step through the code (to try and learn how the code works), each time a formula is added it looks like the subroutine starts from the beginning, but then adds the second formula.

Why does it do this and not just add the next formula?

Regards
Chris

You're right. I'm as baffled as you are. How bizarre.

 

[wrightyrx7]

Its confusing right? haha

I got lost when trying to figure out the code

 

[FormR]

each time a formula is added it looks like the subroutine starts from the beginning

The code is changing cells on the sheet, causing the change event to fire again.

You need to disable events at an appropriate time and re-enable at the end.

For example:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Application.EnableEvents = False
    'code
Application.EnableEvents = True
End Sub

 

[RoryA]

For example:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    Dim WRng                  As Range
    Dim Cell                  As Range

    On Error Resume Next
    Set WRng = Intersect(Me.Columns("A"), Target)
    On Error GoTo Err_handle

    If Not WRng Is Nothing Then
        Application.EnableEvents = False
        For Each Cell In WRng
            With Cell
                If .Value <> vbNullString Then
                    .Offset(0, 1).FormulaR1C1 = "=VLOOKUP(RC[-1],'All Staff (Names)'!C1:C3,3,FALSE)"
                    .Offset(0, 2).FormulaR1C1 = "=VLOOKUP(RC[-1],'All Staff (Names)'!C1:C3,2,FALSE)"
                Else
                    .Offset(0, 1).Resize(, 2).ClearContents
                End If
            End With
        Next Cell
        Application.EnableEvents = True
    End If

    Exit Sub

Err_handle:
    Application.EnableEvents = True

End Sub

Note the error handler to ensure events always get reset.