Combining 2 Worksheet_Change

[rmak85]

Hi all, im self teaching myself vba and I have a problem trying to combine my 2 vba codes.

Code 1 -This bit of code uses (H:H) as a drop down list, which then pastes a vlookup to the next cell to lookup data on a separate data worksheet (Supplier Details) It then copies the cell an pastes its as values instead of having a formula in the cell.

 'supplier details
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    ActiveCell.Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(R[0]C[-1],'Supplier Details'!R[-4]C[-8]:R[322]C[-7],2,FALSE)"
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Code 2 - The cell in column 26 is a drop down closed or open. This determines if it is closed, then the date is added to the next cell.

'Add Closed Date
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Column = 26 And Target.Cells.Count = 1 Then
'Determine if Termed was chosen
    If Target.Value = "Closed" Then
    ActiveSheet.Unprotect 'Password:="password"
    Range("AA" & Target.Row) = Date
    Application.EnableEvents = False
    ActiveSheet.Protect 'Password:="password"
    Application.EnableEvents = True
    End If
    End If
End Sub

Thanks

 

[RoryA]

Welcome to the forum.

You could try something like this:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell                  As Range
    If Not Intersect(Target, Range("H:H")) Is Nothing Then
        'supplier details
        Application.ScreenUpdating = False
        With Target.Offset(0, 1)
            .FormulaR1C1 = "=VLOOKUP(R[0]C[-1],'Supplier Details'!R[-4]C[-8]:R[322]C[-7],2,FALSE)"
            .Value = .Value
        End With
        Application.ScreenUpdating = True
    End If
    'Add Closed Date
    If Not Intersect(Target, Columns(26)) Is Nothing Then
        Me.Unprotect    'Password:="password"
        Application.EnableEvents = False
        For Each cell In Intersect(Target, Columns(26)).Cells
            'Determine if Termed was chosen
            If cell.Value = "Closed" Then Range("AA" & cell.Row) = Date
        Next cell
        Me.Protect    'Password:="password"
        Application.EnableEvents = True
    End If

End Sub

 

[steve the fish]

Is the target cell just one cell in the first one as the vlookup formula would move its lookup table as you moved down column H. Which is the cell?

 

[rmak85]

Yes that is correct, (H:H) is the active cell so each new row will have a new lookup.
Thanks Rory, that solves the problem. I will try and understand how you did this. Many thanks

 

[steve the fish]

Im afraid you misunderstood. If you are using different vlookups on different rows then your lookup table is moving. This is rarely intentional.

 

[RoryA]

That is a good point. What is the lookup table range supposed to be?

 

[rmak85]

Ah yes I see what you mean. The Lookup is in worksheet 'Supplier Details' (A1:B200)
I have one more problem, the above code Rory posted works apart for the moving vlook mentioned. However there is a conflict "With Target.Offset(0, 1)" with a bit code attached to a button which is on the worksheet.
The purpose of the button is to create a new row for adding a new concern information (copied from my hidden row 5 which serves as a template) to the bottom of the worksheet as the worksheet is protected.

Sub CommandButton1_Click()
    ' Create new event
    Application.ScreenUpdating = False
    
    ActiveSheet.Unprotect 'Password:="password"
    Rows("5:5").Select
    Selection.EntireRow.Hidden = False
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Supplier").Select
    
    ActiveSheet.Range("F" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.EntireRow.Select
    ActiveSheet.Paste
    
    Rows("5:5").Select
    Selection.EntireRow.Hidden = True
    ActiveSheet.Protect 'Password:="password"
    Application.ScreenUpdating = True
End Sub