# Change macro according to cell value



## Lux Aeterna (Dec 20, 2022)

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.


----------



## Flashbond (Dec 20, 2022)

```
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 (Dec 20, 2022)

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 (Dec 20, 2022)

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 (Dec 20, 2022)

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


----------



## Flashbond (Dec 20, 2022)

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 (Dec 21, 2022)

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 (Dec 26, 2022)

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!🎉


----------

