Change macro according to cell value

[Lux Aeterna]

I suppose this is a really long shot, but you guys here can make miracles!

There's an excel workbook that contains three sheets. One named List2022, one named List2023 and one named Results. Next year we'll add a List2024 sheet and so on.

In the results sheet there's a macro that copies a cell to the List2022 sheet.

The macro is here

Sub ÁðïèÞêåõóç()
    Application.ScreenUpdating = False
    Dim ID As Range, sup As String, sID As String
    If Sheets("Results").Range("U2") = "" Then
        MsgBox ("Ôï ID äåí ìðïñåß íá åßíáé êåíü.")
        Sheets("Results").Range("U2").Select
        Exit Sub
    End If
    If Sheets("Results").Range("U3") = "" Then
        MsgBox ("Ôï êßôñéíï êåëß äåí ìðïñåß íá åßíáé êåíü.")
        Sheets("Results").Range("U3").Select
        Exit Sub
    End If
    Set ID = Sheets("List2022").Range("A:A").Find(Sheets("Results").Range("U2").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not ID Is Nothing Then
        If ID.Offset(, 1) <> "" Then
            If MsgBox("Ôï áðïôÝëåóìá Ý÷åé Þäç äïèåß áðü " & ID.Offset(, 37) & "." & Chr(10) _
                & "Èåò ïðùóäÞðïôå íá ôï áíôéêáôáóôÞóåéò;", vbYesNo + vbDefaultButton2) = vbYes Then
                ID.Offset(, 1) = Sheets("Results").Range("AB9")
            Else
                Sheets("Results").Range("U2:X3").ClearContents
                Sheets("Results").Range("U2:X2").Select
                MsgBox ("Âåâáéþóïõ üôé ôá óôïé÷åßá ðïõ êáôá÷þñçóåò áöïñïýí ôï óùóôü äåßãìá! Áí ü÷é, ðÜôá êáèáñéóìü!")
                Exit Sub
            End If
        Else
            ID.Offset(, 1) = Sheets("Results").Range("AB9")
        End If
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:="C:\Users\pc50\Desktop\New results\" & Range("AH1").Value _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    Else
        MsgBox ("Ôï ID " & Sheets("Results").Range("U2") & " äåí õðÜñ÷åé óôç ëßóôá ôùí List2022." & Chr(10) & "¸ëåãîå üôé Ýâáëåò ôï óùóôü ID.")
        Sheets("Results").Range("U2:X3").ClearContents
        Sheets("Results").Range("U2:X2").Select
        Exit Sub
    End If
    Application.ScreenUpdating = True
End Sub

What I need is an adjustment to the macro so that List2022 changes according to the value of cell Y2 of the result sheets.

So, if Results Y2 is 2022 I need the data from result sheets to be copied to the List2022 sheet. If Results Y2 is 2023 I need the data from result sheets to be copied to the List2023 sheet and so on for each new sheet I add.

Hope that's possible!

Thanks in advance and happy holidays to everyone.

 

[Legacy 143009]

Sub ÁðïèÞêåõóç()
    Application.ScreenUpdating = False
    Dim ID As Range, sup As String, sID As String
    If Sheets("Results").Range("U2") = "" Then
        MsgBox ("Ôï ID äåí ìðïñåß íá åßíáé êåíü.")
        Sheets("Results").Range("U2").Select
        Exit Sub
    End If
    If Sheets("Results").Range("U3") = "" Then
        MsgBox ("Ôï êßôñéíï êåëß äåí ìðïñåß íá åßíáé êåíü.")
        Sheets("Results").Range("U3").Select
        Exit Sub
    End If
    Set ID = Sheets("List" & Range("Y2").Value).Range("A:A").Find(Sheets("Results").Range("U2").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not ID Is Nothing Then
        If ID.Offset(, 1) <> "" Then
            If MsgBox("Ôï áðïôÝëåóìá Ý÷åé Þäç äïèåß áðü " & ID.Offset(, 37) & "." & Chr(10) _
                & "Èåò ïðùóäÞðïôå íá ôï áíôéêáôáóôÞóåéò;", vbYesNo + vbDefaultButton2) = vbYes Then
                ID.Offset(, 1) = Sheets("Results").Range("AB9")
            Else
                Sheets("Results").Range("U2:X3").ClearContents
                Sheets("Results").Range("U2:X2").Select
                MsgBox ("Âåâáéþóïõ üôé ôá óôïé÷åßá ðïõ êáôá÷þñçóåò áöïñïýí ôï óùóôü äåßãìá! Áí ü÷é, ðÜôá êáèáñéóìü!")
                Exit Sub
            End If
        Else
            ID.Offset(, 1) = Sheets("Results").Range("AB9")
        End If
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:="C:\Users\pc50\Desktop\New results\" & Range("AH1").Value _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    Else
        MsgBox ("Ôï ID " & Sheets("Results").Range("U2") & " äåí õðÜñ÷åé óôç ëßóôá ôùí List" & Range("Y2").Value & "." & Chr(10) & "¸ëåãîå üôé Ýâáëåò ôï óùóôü ID.")
        Sheets("Results").Range("U2:X3").ClearContents
        Sheets("Results").Range("U2:X2").Select
        Exit Sub
    End If
    Application.ScreenUpdating = True
End Sub

 

[HaHoBe]

Hi Lux Aeterna,

don't mix qualified sheetnames with Activesheet:

Sub MrE_1225092_161620F()
  Dim ID As Range
  Dim sup As String
  Dim sID As String
  
  Application.ScreenUpdating = False
  With Worksheets("Results")
    If .Range("U2") = "" Then
      MsgBox ("Ôï ID äåí ìðïñåß íá åßíáé êåíü.")
      Application.Goto .Range("U2")
      Exit Sub
    End If
    If .Range("U3") = "" Then
      MsgBox ("Ôï êßôñéíï êåëß äåí ìðïñåß íá åßíáé êåíü.")
      Application.Goto .Range("U3")
      Exit Sub
    End If
    Set ID = Sheets("List" & .Range("Y2").Value).Range("A:A").Find(.Range("U2").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not ID Is Nothing Then
      If ID.Offset(, 1) <> "" Then
        If MsgBox("Ôï áðïôÝëåóìá Ý÷åé Þäç äïèåß áðü " & ID.Offset(, 37) & "." & Chr(10) _
            & "Èåò ïðùóäÞðïôå íá ôï áíôéêáôáóôÞóåéò;", vbYesNo + vbDefaultButton2) = vbYes Then
          ID.Offset(, 1) = .Range("AB9")
        Else
          .Range("U2:X3").ClearContents
          Application.Goto .Range("U2:X2")
          MsgBox ("Âåâáéþóïõ üôé ôá óôïé÷åßá ðïõ êáôá÷þñçóåò áöïñïýí ôï óùóôü äåßãìá! Áí ü÷é, ðÜôá êáèáñéóìü!")
          Exit Sub
        End If
      Else
        ID.Offset(, 1) = .Range("AB9")
      End If
      .ExportAsFixedFormat Type:=xlTypePDF, _
          Filename:="C:\Users\pc50\Desktop\New results\" & .Range("AH1").Value, _
          Quality:=xlQualityStandard, _
          IncludeDocProperties:=True, _
          IgnorePrintAreas:=False, _
          OpenAfterPublish:=True
    Else
      MsgBox ("Ôï ID " & .Range("U2") & " äåí õðÜñ÷åé óôç ëßóôá ôùí List2022." & Chr(10) & "¸ëåãîå üôé Ýâáëåò ôï óùóôü ID.")
      .Range("U2:X3").ClearContents
      Application.Goto .Range("U2:X2")
    End If
  End With
  Application.ScreenUpdating = True
End Sub

Holger

 

[Lux Aeterna]

Thank you both of you! I'll check tomorrow from work computer.

@HaHoBe I am not sure what you mean by "do not mix".

 

[HaHoBe]

Hi Lux Aeterna,

if you do not specify a sheet before a range or cell code will run on the Activesheet. In your original code there are lines like Sheets("Results").Range("U2") which will refer to Worksheet Results as well as

        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:="C:\Users\pc50\Desktop\New results\" & Range("AH1").Value _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

where you rely on the ActiveSheet at the beginning as well as a Range which is located on the ActiveSheet whereas I have wrapped the line to be part of Worksheet Results.

I try to make it obvious on which worksheet any code should run and not hope for the proper workbook as well as worksheet to be the active one.

Holger

 

[Legacy 143009]

He means that my code will only take the Y2 referance for the sheet you are running the macro (ActiveSheet). My code won't work if you are running the macro other than "Results" sheet.

You should specify the sheet referance if you are running on another sheet. Like Sheets("Results").Range("Y2").Value

 

[HaHoBe]

Hi Lux Aeterna,

added a check for the availability of a sheet mentioned in Sheets Results Cell Y2:

Sub MrE_1225092_161620F_mod2()
' https://www.mrexcel.com/board/threads/change-macro-according-to-cell-value.1225092/
' Updated: 20221221
' Reason:  added check for worksheet
  Dim ID As Range
  Dim sup As String
  Dim sID As String
  Dim sWs As String
  
  Application.ScreenUpdating = False
  With Worksheets("Results")
    If .Range("U2") = "" Then
      MsgBox ("Ôï ID äåí ìðïñåß íá åßíáé êåíü.")
      Application.Goto .Range("U2")
      Exit Sub
    End If
    If .Range("U3") = "" Then
      MsgBox ("Ôï êßôñéíï êåëß äåí ìðïñåß íá åßíáé êåíü.")
      Application.Goto .Range("U3")
      Exit Sub
    End If
    sWs = "List" & .Range("Y2").Value
    If Evaluate("ISREF('" & sWs & "'!A1)") Then
      Set ID = Sheets(sWs).Range("A:A").Find(.Range("U2").Value, LookIn:=xlValues, lookat:=xlWhole)
      If Not ID Is Nothing Then
        If ID.Offset(, 1) <> "" Then
          If MsgBox("Ôï áðïôÝëåóìá Ý÷åé Þäç äïèåß áðü " & ID.Offset(, 37) & "." & Chr(10) _
              & "Èåò ïðùóäÞðïôå íá ôï áíôéêáôáóôÞóåéò;", vbYesNo + vbDefaultButton2) = vbYes Then
            ID.Offset(, 1) = .Range("AB9")
          Else
            .Range("U2:X3").ClearContents
            Application.Goto .Range("U2:X2")
            MsgBox ("Âåâáéþóïõ üôé ôá óôïé÷åßá ðïõ êáôá÷þñçóåò áöïñïýí ôï óùóôü äåßãìá! Áí ü÷é, ðÜôá êáèáñéóìü!")
            Exit Sub
          End If
        Else
          ID.Offset(, 1) = .Range("AB9")
        End If
        .ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:="C:\Users\pc50\Desktop\New results\" & .Range("AH1").Value, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
      Else
        MsgBox ("Ôï ID " & .Range("U2") & " äåí õðÜñ÷åé óôç ëßóôá ôùí List2022." & Chr(10) & "¸ëåãîå üôé Ýâáëåò ôï óùóôü ID.")
        .Range("U2:X3").ClearContents
        Application.Goto .Range("U2:X2")
      End If
    Else
      MsgBox "No sheet '" & sWs & "' in this workbook.", vbInformation, "Check teh value in Cell Y2, please"
    End If
  End With
  Set ID = Nothing
  Application.ScreenUpdating = True
End Sub

Ciao,
Holger

 

[Lux Aeterna]

Thank you both for explaining that and for the code you provided!

This macro only runs on the active sheet through an assigned button, so I guess it's ok as it is.

I'll use @Flashbond 's code for now, as it's slightly more familiar to me.

@HaHoBe, the sheet availability addition you made is absolutely insightful, and once I find the time to check your code I'll let you know if it runs smoothly!

Have a great holiday and a happy new year!