Is there a way to set one cell on one worksheet to equal one cell on another worksheet based on the-CodePudding

So I have a dropdown to select the year; 2015, 2016, 2017, etc, but based on which year is selected, I want to populate cells from a specific worksheet. So for example if 2015 is selected, cell K3 in the current worksheet equals cell E12 from the 2015 worksheet. Any help would be greatly appreciated, thanks!

Edit:

So far I have the following VBA code:

 Option Explicit
 Sub Worksheet_Change(ByVal Target As Range)

 If Range("J2") = "2016" Then
     Range("K3") = ActiveWorkbook.Worksheets("2016").Range("E12")
 Else
     Range("K3") = "0"
 End If

 End Sub

...but keep getting this error:

 Run-time error '1004':

 Method 'Range' of object '_Worksheet' failed

...and then Excel restarts.

CodePudding user response：

A Drop-Down Worksheet Change

In the initial solution, when writing to the destination cell, the event would get re-triggered. Although it would finish with the If Intersect... line, I consider it as unacceptable (wrong). Study the following solution how this is avoided.
To see (prove) the difference, you could add e.g. the line MsgBox "Entering Change Event" at the beginning of each code which would show that the wrong solution shows the message box twice on each change in the drop-down cell.

Corrected and Improved

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Const sAddress As String = "E12" ' Source Cell (read from)
    
    Const dddAddress As String = "J2" ' Destination Drop-Down Cell
    Const dAddress As String = "K3" ' Destination Cell (written to)
    Const dValNoWorksheet As Long = 0 ' source worksheet not found
    Const dValBlank As Long = 0 ' source cell blank i.e. [Empty],[=""],['],...)
    
    Dim dddCell As Range: Set dddCell = Range(dddAddress)
    ' This will prevent the succeeding code to run if there was no change
    ' in the drop-down cell.
    If Intersect(Target, dddCell) Is Nothing Then Exit Sub ' not ddd cell
    
    ' 'Me' is the worksheet containing this code, while 'Me.Parent' is
    ' its workbook which is also 'ThisWorbook'.
    On Error Resume Next ' defer error trapping
    Dim sws As Worksheet: Set sws = Me.Parent.Worksheets(CStr(dddCell.Value))
    On Error GoTo 0 ' enable error trapping ('Err.Number = 0')
    
    ' The following line prevents triggering the event again when writing
    ' to the destination cell ('dCell').
    Application.EnableEvents = False
    ' Immediately after the previous line start an error-handling routine
    ' to prevent exiting the procedure with events disabled. Its flow
    ' is self-explanatory but study it carefully.
    On Error GoTo ClearError ' enable error trapping
    
    ' Now you do your thing. If something goes wrong, the error handler
    ' will make make sure that the procedure will exit only after enabling
    ' events.
    
    Dim dCell As Range: Set dCell = Range(dAddress)
    
    If sws Is Nothing Then ' worksheet doesn't exist
        dCell.Value = dValNoWorksheet
    Else ' worksheet exists
        Dim sCell As Range: Set sCell = sws.Range(sAddress)
        If Len(CStr(sCell.Value)) = 0 Then ' blank
            dCell.Value = dValBlank
        Else ' not blank
            dCell.Value = sCell.Value
        End If
    End If

SafeExit:
    ' Be careful, if an error occurs here, it will trigger an endless loop,
    ' since the error handler is still active.
    Application.EnableEvents = True
    
    Exit Sub

ClearError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Resume SafeExit ' the error handler stays active('Err.Number = 0')

End Sub

Wrong

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, Range("J2")) Is Nothing Then Exit Sub ' not dd cell
    
    On Error Resume Next
    Dim ws As Worksheet: Set ws = Me.Parent.Worksheets(CStr(Range("J2").Value))
    On Error GoTo 0

    If ws Is Nothing Then ' worksheet doesn't exist
        Range("K3").Value = 0
    Else ' worksheet exists
        If Len(CStr(ws.Range("E12").Value)) = 0 Then ' blank
            Range("K3").Value = 0
        Else ' not blank
            Range("K3").Value = ws.Range("E12").Value
        End If
    End If

End Sub