Private Sub Worksheet_Change - help needed!!!

J

jnathan

New Member
Joined
Jul 8, 2013
Messages
48
Hi Guys

The following code is supposed to pull in Evaluated values from one s/sheet ("Lookback.xlsm") to a different central s/sheet where the ID/Ref matches between the 2 s/sheets. Desired values within the row where the ID/Ref matches is then supposed to populate the central; s/sheet (where the code below sits within Sheet1) I am however having the following issues:

1. it's not working even though I have previously used this code (but in Excel 2003 - currently using Exel 2007). It is doing something as #VALUE! is being populated in the designated columns

2. Once it has populated a row (whiich is triggered by double clicking a populated cell in Column B), Excel goes into Not Responding mode and stays there.

The code is as follows - I really need some help and expertise with this one!!!
:confused:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim ocDrop As String
Dim statusDrop As String
Dim esclDrop As String
If Target.Row <> 1 Then
If Target.Column = 2 Then
If IsEmpty(Target.Value) = False Then
Target.Offset(0, -1).Interior.Colorlndex = 0
Target.Offset(0, 3) = "Open"
Target.Offset(0, 20) = Evaluate("=VLOOKUP(" & Chr(34) & Target.Value & Chr(34) & ",'[GRL 2wk Lookback - Equities.xlsm]Sheetl'!$A:$W,2,FALSE)") ' GRL Alerts
Target.Offset(0, 21) = Evaluate("=VLOOKUP(" & Chr(34) & Target.Value & Chr(34) & ",'[GRL 2wk Lookback - Equities.xlsm]Sheetl'!$A:$W,3,FALSE)")
Target.Offset(0, 22) = Evaluate("=VLOOKUP(" & Chr(34) & Target.Value & Chr(34) & ",'[GRL 2wk Lookback - Equities.xlsm]Sheetl'!$A:$W,4,FALSE)")
Target.Offset(0, 23) = Evaluate("=VLOOKUP(" & Chr(34) & Target.Value & Chr(34) & ",'[GRL 2wk Lookback - Equities.xlsm]Sheetl'!$A:$W,5,FALSE)")
Target.Offset(0, 24) = Evaluate("=VLOOKUP(" & Chr(34) & Target.Value & Chr(34) & ",_[GRL 2wk Lookback - Equities.xlsm]Sheetl'!$A:$W,6,FALSE)")
Target.Offset(0, 25) = Evaluate("=VLOOKUP(" & Chr(34) & Target.Value & Chr(34) & ",'[GRL 2wk Lookback - Equities.xlsm]Sheetl'!$A:$W,7,FALSE)")
Target.Offset(0, 26) = Evaluate("=VLOOKUP(" & Chr(34) & Target.Value & Chr(34) & ",'[GRL 2wk Lookback - Equities.xlsm]Sheetl'!$A:$W,8,FALSE)")
Target.Offset(0, 27) = Evaluate("=VLOOKUP(" & Chr(34) & Target.Value & Chr(34) & ",'[GRL 2wk Lookback - Equities.xlsm]Sheetl'i$A:$W,9,FALSE)")
Target.Offset(0, 19) = "GRL 2wk Lookback - Equities"
Target.Offset(0, 18) = "=NETWORKDAYS(RC[2],TODAY())"
'colour the cells
For i = 0 To 27
Target.Offset(0, i).Interior.Colorlndex = 0
Next i
'check the column header against the ref sheet and, if the titles match
'populate the appropriate dropdown from the Ref sheet
For j = 0 To 5 Step 1
For k = 1 To 10
'Check if the column header in the current sheet matches
'the column header in the ref sheet
If Sheets("Ref").Range("a1").Offset(i, k) = Range("il").Offset(0, j) Then
'the column headers match so get a comma separted list of the
'dropdown options from the Ref sheet
ocDrop = Empty
i = 1
Do While Sheets("Ref").Range("al").Offset(i, k) <> Empty
ocDrop = ocDrop & Sheets("Ref").Range("al").Offset(i, k) & ","
i = i + 1
Loop
'remove the trailing comma from the dropdown list "ocDrop"
ocDrop = Left(ocDrop, Len(ocDrop) - 1)
'add the dropdown to the relevant cell
With Range("i1").Offset(Target.Row - 1, j).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=ocDrop
.IgnoreBlank = True
.lnCellDropdown = True
.lnputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.Showlnput = True
.ShowError = True
End With
'exit the FOR and go to the next column header to be checked
Exit For
End If
Next k
Next j
End If 'lsNumeric(Target.Value)
End If 'Target.Column = 2
If Target.Column = 5 Then ' enters the date of closed alert when set to 'Closed'
If Target.Value = "Closed" Then
Target.Offset(0, 2) = Date
'Range("T65536") = Range("T" & Target.Row).Value
'Range("G65536") = Range("G" & Target.Row).Value
Target.Offset(0, 15) = "=NETWORKDAYS(RC[2],RC[-13])"
Target.Offset(0, 15) = Target.Offset(0, 15).Value
End If
End If
If Target.Column = 5 Then ' removes the closed date if re-opened
If Target.Value = "Open" Then
Target.Offset(0, 2).ClearContents
Target.Offset(0, 15) = "=NETWORKDAYS(RC[2],TODAY())"
End If
End If
If Target.Column = 6 Then ' enters "Awaiting Sign-Off' into escalation sign-off dates
If Target.Value = "Explanation Required" Then
Target.Offset(0, 7) = "Awaiting Sign-Off '"
Target.Offset(0, 10) = "Awaiting Sign-Off'"
Target.Offset(0, 13) = "Awaiting Sign-Off'"
End If
End If
If Target.Column = 6 Then ' enters "Awaiting Sign-Off" into escalation sign-off dates
If Target.Value = "Investigation" Then
Target.Offset(0, 7) = "Awaiting Sign-Off'"
Target.Offset(0, 10) = "Awaiting Sign-Off'"
Target.Offset(0, 13) = "Awaiting Sign-Off'"
End If
End If
If Target.Column = 6 Then ' enters "Awaiting Sign-Off into escalation sign-off dates
If Target.Value = "Breach" Then
Target.Offset(0, 7) = "Awaiting Sign-Off'"
Target.Offset(0, 10) = "Awaiting Sign-Off'"
Target.Offset(0, 13) = "Awaiting Sign-Off'"
End If
End If

If Target.Column = 9 Then ' enters the date of escalation if Escalation Channel is populated
If IsEmpty(Target.Value) = False Then
Target.Offset(0, 1) = Date
End If
End If
If Target.Column = 11 Then ' enters L3/MC sign-off date
If IsEmpty(Target.Value) = False Then
Target.Offset(0, 2) = Date
End If
End If
If Target.Column = 14 Then ' enters S# sign-off date
If IsEmpty(Target.Value) = False Then
Target.Offset(0, 2) = Date
End If
End If
If Target.Column = 17 Then ' enters TS sign-off date
If IsEmpty(Target.Value) = False Then
Target.Offset(0, 2) = Date
End If
End If
If Target.Column = 22 Then ' enters week commencing date
If IsDate(Target.Value) Then
Target.Offset(0, -21) = Target.Value - Weekday(Target.Value)
End If
End If
If Target.Column = 20 Then
If Target.Value >= 15 Then
Target.Offset(0, -12) = "> 15"
End If
End If
If Target.Column = 20 Then
If Target.Value > 5 And Target.Value < 15 Then
Target.Offset(0, -12) = ">5 <15"
End If
End If
If Target.Column = 20 Then
If Target.Value < 6 Then
Target.Offset(0, -12) = "< 5"
End If
End If
End If
End Sub
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Sort by date Sort by votes
I wouldn't use Evaluate at all there - I'd use something like this:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Dim ocDrop                As String
    Dim statusDrop            As String
    Dim esclDrop              As String

    Dim vMatch
    Dim rngTable              As Range

    Set rngTable = Workbooks("GRL 2wk Lookback - Equities.xlsm").Sheets("Sheetl").Range("A:W")

    If Target.Row <> 1 Then
        If Target.Column = 2 Then
            If IsEmpty(Target.Value) = False Then
                Target.Offset(0, -1).Interior.Colorlndex = 0
                Target.Offset(0, 3) = "Open"
                vMatch = Application.Match(Target.Value, rngTable.Columns(1), 0)
                If Not IsError(vMatch) Then

                    Target.Offset(0, 20) = rngTable.Cells(vMatch, 2)    ' GRL Alerts
                    Target.Offset(0, 21) = rngTable.Cells(vMatch, 3)
                    Target.Offset(0, 22) = rngTable.Cells(vMatch, 4)
                    Target.Offset(0, 23) = rngTable.Cells(vMatch, 5)
                    Target.Offset(0, 24) = rngTable.Cells(vMatch, 6)
                    Target.Offset(0, 25) = rngTable.Cells(vMatch, 7)
                    Target.Offset(0, 26) = rngTable.Cells(vMatch, 8)
                    Target.Offset(0, 27) = rngTable.Cells(vMatch, 9)
                End If
                Target.Offset(0, 19) = "GRL 2wk Lookback - Equities"
                Target.Offset(0, 18) = "=NETWORKDAYS(RC[2],TODAY())"
                'colour the cells
                For i = 0 To 27
                    Target.Offset(0, i).Interior.Colorlndex = 0
                Next i
                'check the column header against the ref sheet and, if the titles match
                'populate the appropriate dropdown from the Ref sheet
                For j = 0 To 5 Step 1
                    For k = 1 To 10
                        'Check if the column header in the current sheet matches
                        'the column header in the ref sheet
                        If Sheets("Ref").Range("a1").Offset(i, k) = Range("il").Offset(0, j) Then
                            'the column headers match so get a comma separted list of the
                            'dropdown options from the Ref sheet
                            ocDrop = Empty
                            i = 1
                            Do While Sheets("Ref").Range("al").Offset(i, k) <> Empty
                                ocDrop = ocDrop & Sheets("Ref").Range("al").Offset(i, k) & ","
                                i = i + 1
                            Loop
                            'remove the trailing comma from the dropdown list "ocDrop"
                            ocDrop = Left(ocDrop, Len(ocDrop) - 1)
                            'add the dropdown to the relevant cell
                            With Range("i1").Offset(Target.Row - 1, j).Validation
                                .Delete
                                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=ocDrop
                                .IgnoreBlank = True
                                .lnCellDropdown = True
                                .lnputTitle = ""
                                .ErrorTitle = ""
                                .InputMessage = ""
                                .ErrorMessage = ""
                                .Showlnput = True
                                .ShowError = True
                            End With
                            'exit the FOR and go to the next column header to be checked
                            Exit For
                        End If
                    Next k
                Next j
            End If    'lsNumeric(Target.Value)
        End If    'Target.Column = 2
        If Target.Column = 5 Then    ' enters the date of closed alert when set to 'Closed'
            If Target.Value = "Closed" Then
                Target.Offset(0, 2) = Date
                'Range("T65536") = Range("T" & Target.Row).Value
                'Range("G65536") = Range("G" & Target.Row).Value
                Target.Offset(0, 15) = "=NETWORKDAYS(RC[2],RC[-13])"
                Target.Offset(0, 15) = Target.Offset(0, 15).Value
            End If
        End If
        If Target.Column = 5 Then    ' removes the closed date if re-opened
            If Target.Value = "Open" Then
                Target.Offset(0, 2).ClearContents
                Target.Offset(0, 15) = "=NETWORKDAYS(RC[2],TODAY())"
            End If
        End If
        If Target.Column = 6 Then    ' enters "Awaiting Sign-Off' into escalation sign-off dates
            If Target.Value = "Explanation Required" Then
                Target.Offset(0, 7) = "Awaiting Sign-Off '"
                Target.Offset(0, 10) = "Awaiting Sign-Off'"
                Target.Offset(0, 13) = "Awaiting Sign-Off'"
            End If
        End If
        If Target.Column = 6 Then    ' enters "Awaiting Sign-Off" into escalation sign-off dates
            If Target.Value = "Investigation" Then
                Target.Offset(0, 7) = "Awaiting Sign-Off'"
                Target.Offset(0, 10) = "Awaiting Sign-Off'"
                Target.Offset(0, 13) = "Awaiting Sign-Off'"
            End If
        End If
        If Target.Column = 6 Then    ' enters "Awaiting Sign-Off into escalation sign-off dates
            If Target.Value = "Breach" Then
                Target.Offset(0, 7) = "Awaiting Sign-Off'"
                Target.Offset(0, 10) = "Awaiting Sign-Off'"
                Target.Offset(0, 13) = "Awaiting Sign-Off'"
            End If
        End If

        If Target.Column = 9 Then    ' enters the date of escalation if Escalation Channel is populated
            If IsEmpty(Target.Value) = False Then
                Target.Offset(0, 1) = Date
            End If
        End If
        If Target.Column = 11 Then    ' enters L3/MC sign-off date
            If IsEmpty(Target.Value) = False Then
                Target.Offset(0, 2) = Date
            End If
        End If
        If Target.Column = 14 Then    ' enters S# sign-off date
            If IsEmpty(Target.Value) = False Then
                Target.Offset(0, 2) = Date
            End If
        End If
        If Target.Column = 17 Then    ' enters TS sign-off date
            If IsEmpty(Target.Value) = False Then
                Target.Offset(0, 2) = Date
            End If
        End If
        If Target.Column = 22 Then    ' enters week commencing date
            If IsDate(Target.Value) Then
                Target.Offset(0, -21) = Target.Value - Weekday(Target.Value)
            End If
        End If
        If Target.Column = 20 Then
            If Target.Value >= 15 Then
                Target.Offset(0, -12) = "> 15"
            End If
        End If
        If Target.Column = 20 Then
            If Target.Value > 5 And Target.Value < 15 Then
                Target.Offset(0, -12) = ">5 <15"
            End If
        End If
        If Target.Column = 20 Then
            If Target.Value < 6 Then
                Target.Offset(0, -12) = "< 5"
            End If
        End If
    End If
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Worksheet_Change event doesn't trigger when using paste values
Replies
7
Views
1K
spprtpplcm
S
M
  • Solved
XLOOKUP help (maybe), not sure what function to use
Replies
4
Views
230
MeaclH
M
O
  • Question Question
Multiple Private Sub Worksheet_Change
Replies
4
Views
988
Zot
Z
B
  • Solved
Help Combining 2 Private Sub Worksheet_Change(ByVal Target As Range) Codes
Replies
8
Views
2K
brett1again
B
S
  • Question Question
Help with Duplicate Entries
Replies
0
Views
637
skidda420
S

Forum statistics

Threads
1,223,214
Messages
6,170,771
Members
452,353
Latest member
strainu

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top