Change macro according to cell value

L

Lux Aeterna

Board Regular
Joined
Aug 27, 2015
Messages
191
Office Version
  1. 2019
Platform
  1. Windows
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

VBA Code: 
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.
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Sort by date Sort by votes
VBA Code: 
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
 
Upvote 0
Solution
Hi Lux Aeterna,

don't mix qualified sheetnames with Activesheet:

VBA Code: 
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
 
Upvote 0
Thank you both of you! I'll check tomorrow from work computer.

@HaHoBe I am not sure what you mean by "do not mix".
 
Upvote 0
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

Rich (BB code): 
        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
 
Upvote 0
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
 
Upvote 0
Hi Lux Aeterna,

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

VBA Code: 
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
 
Upvote 0
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!🎉
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Solved
Save to different folder according to cell value (adjust my macro)
2
Replies
12
Views
548
HaHoBe
HaHoBe
L
  • Solved
Add a "save workbook" line in a macro
Replies
2
Views
290
Lux Aeterna
L
M
  • Solved
VBA comparing cell values dosen't work consistantly
Replies
6
Views
113
michaelehoudek
M
L
  • Solved
Macro slowing down because of an extra sheet
2
Replies
16
Views
566
Lux Aeterna
L
C
  • Solved
Updating a specific cell value in an autofiltered table
Replies
3
Views
230
skillilea
S

Forum statistics

Threads
1,215,073
Messages
6,122,976
Members
449,095
Latest member
Mr Hughes

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