I need to shorten my macro.

M

michellin

Board Regular
Joined
Oct 4, 2011
Messages
56
Office Version
  1. 2019
Platform
  1. Windows
Hy guys,

I'm a noob in macro's, but i can't figure it out, with forum and record function.
I'm starting to apologise first on my english, because i'm canadian and french :) loool
I got a totaly fonctional macro, but it's very very very long.
I'm pretty sure you guys expert, can find a way to shortent it, or just tell me it's totally impossible to shortent it.
I made my tools for emprove my working station and save some time on others.
I made a sheet with 2 drop down list, with name, and name of compagny. When i choose one or the others, all cell's are changing automatically.
I got a sheet name "GABARIT" where my drop down cells are, and a sheet name "donnée".
On the sheet "donnée" i got line from 2 to 32 it my name of person(drop down name"requérant") , and from line 35 to 235 it's my compagny name(drop down name "fournisseur").

I got my macro on sheet "gabarit" (worksheet, change in private)


Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("AC10")) Is Nothing Then
        Select Case Range("AC10")
            Case "Francois Masse": Application.Run "Requerant_ligne2"
            Case "Yvon Malenfant": Application.Run "Requerant_ligne3"
            Case "André Perrier": Application.Run "Requerant_ligne4"
            Case "Jean-Marc Touchette": Application.Run "Requerant_ligne5"
            Case "Éric Pronovost": Application.Run "Requerant_ligne6"
            Case "François Perrier": Application.Run "Requerant_ligne7"
            Case "Éric Casavant": Application.Run "Requerant_ligne8"
            Case "Hugues Francoeur": Application.Run "Requerant_ligne9"
            Case "Manon Paris": Application.Run "Requerant_ligne10"
            'Case "": Application.Run "Requerant_ligne11"
            'Case "": Application.Run "Requerant_ligne12"
            'Case "": Application.Run "Requerant_ligne13"
            'Case "": Application.Run "Requerant_ligne14"
            'Case "": Application.Run "Requerant_ligne15"
            'Case "": Application.Run "Requerant_ligne16"
            'Case "": Application.Run "Requerant_ligne17"
            'Case "": Application.Run "Requerant_ligne18"
            'Case "": Application.Run "Requerant_ligne19"
            'Case "": Application.Run "Requerant_ligne20"
            'Case "": Application.Run "Requerant_ligne21"
            'Case "": Application.Run "Requerant_ligne22"
            'Case "": Application.Run "Requerant_ligne23"
            'Case "": Application.Run "Requerant_ligne24"
            'Case "": Application.Run "Requerant_ligne25"
            'Case "": Application.Run "Requerant_ligne26"
            'Case "": Application.Run "Requerant_ligne27"
            'Case "": Application.Run "Requerant_ligne28"
            'Case "": Application.Run "Requerant_ligne29"
            'Case "": Application.Run "Requerant_ligne30"
            'Case "": Application.Run "Requerant_ligne31"
            'Case "": Application.Run "Requerant_ligne32"
          End Select
       End If
       
            
 If Not Intersect(Target, Range("G4")) Is Nothing Then
        Select Case Range("G4")
            Case "ABR RUBANCO": Application.Run "Fournisseur_ligne35"
            Case "ACIER MPI": Application.Run "Fournisseur_ligne36"
            'Case "": Application.Run "Fournisseur_ligne37"
            'Case "": Application.Run "Fournisseur_ligne38"
            'Case "": Application.Run "Fournisseur_ligne39"
            'Case "": Application.Run "Fournisseur_ligne40"
            'Case "": Application.Run "Fournisseur_ligne41"
            'Case "": Application.Run "Fournisseur_ligne42"
            'Case "": Application.Run "Fournisseur_ligne43"
            'Case "": Application.Run "Fournisseur_ligne44"
            'Case "": Application.Run "Fournisseur_ligne45"
            'Case "": Application.Run "Fournisseur_ligne46"
            'Case "": Application.Run "Fournisseur_ligne47"
            'Case "": Application.Run "Fournisseur_ligne48"
            'Case "": Application.Run "Fournisseur_ligne49"
            'Case "": Application.Run "Fournisseur_ligne50"
            'Case "": Application.Run "Fournisseur_ligne51"
            'Case "": Application.Run "Fournisseur_ligne52"
            'Case "": Application.Run "Fournisseur_ligne53"
            'Case "": Application.Run "Fournisseur_ligne54"
            'Case "": Application.Run "Fournisseur_ligne55"
            'Case "": Application.Run "Fournisseur_ligne56"
            'Case "": Application.Run "Fournisseur_ligne57"
            'Case "": Application.Run "Fournisseur_ligne58"
            'Case "": Application.Run "Fournisseur_ligne59"
            'Case "": Application.Run "Fournisseur_ligne60"
            'Case "": Application.Run "Fournisseur_ligne61"
            'Case "": Application.Run "Fournisseur_ligne62"
            'Case "": Application.Run "Fournisseur_ligne63"
            'Case "": Application.Run "Fournisseur_ligne64"
            'Case "": Application.Run "Fournisseur_ligne65"
            'Case "": Application.Run "Fournisseur_ligne66"
            'Case "": Application.Run "Fournisseur_ligne67"
            'Case "": Application.Run "Fournisseur_ligne68"
            'Case "": Application.Run "Fournisseur_ligne69"
            'Case "": Application.Run "Fournisseur_ligne70"
            'Case "": Application.Run "Fournisseur_ligne71"
            'Case "": Application.Run "Fournisseur_ligne72"
            'Case "": Application.Run "Fournisseur_ligne73"
            'Case "": Application.Run "Fournisseur_ligne74"
            'Case "": Application.Run "Fournisseur_ligne75"
            'Case "": Application.Run "Fournisseur_ligne76"
            'Case "": Application.Run "Fournisseur_ligne77"
            'Case "": Application.Run "Fournisseur_ligne78"
            'Case "": Application.Run "Fournisseur_ligne79"
            'Case "": Application.Run "Fournisseur_ligne80"
            'Case "": Application.Run "Fournisseur_ligne81"
            'Case "": Application.Run "Fournisseur_ligne82"
            'Case "": Application.Run "Fournisseur_ligne83"
            'Case "": Application.Run "Fournisseur_ligne84"
            'Case "": Application.Run "Fournisseur_ligne85"
            'Case "": Application.Run "Fournisseur_ligne86"
            'Case "": Application.Run "Fournisseur_ligne87"
            'Case "": Application.Run "Fournisseur_ligne88"
            'Case "": Application.Run "Fournisseur_ligne89"
            'Case "": Application.Run "Fournisseur_ligne90"
            
            
            
            
        End Select
    End If
End Sub

I use Application.Run to keep my macro in private states. I need to exten it from ligne 90 to 235, in the next days. Those one i could not figure out to short it.
But it not neccessary.
Here is the one i would like to shortent, i got a macro for each "Case "": Application.Run "Requerant_ligne02" from 02 to 32, like this :

Private Sub Requerant_ligne2()

    Sheets("GABARIT").Select
    ActiveSheet.Unprotect Password:="magasin1234"
    Range("B12:F13").Select
    Selection.ClearContents
    
    Range("N12:AG13").Select
    Selection.ClearContents
    
    Range("G12:M13").Select
    Selection.ClearContents
    
    Range("S48:AG49").Select
    Selection.ClearContents
    
    
    Sheets("Donnée").Select
    ActiveSheet.Unprotect Password:="magasin1234"
    Range("B2").Select
    Selection.Copy
    Sheets("GABARIT").Select
    Range("B12:F13").Select
    ActiveSheet.Paste

    Sheets("Donnée").Select
    Range("C2").Select
    Selection.Copy
    Sheets("GABARIT").Select
    Range("N12:AG13").Select
    ActiveSheet.Paste
    
    Sheets("Donnée").Select
    Range("D2").Select
    Selection.Copy
    Sheets("GABARIT").Select
    Range("G12:M13").Select
    ActiveSheet.Paste
    
    Sheets("Donnée").Select
    Range("E2").Select
    Selection.Copy
    Sheets("GABARIT").Select
    Range("S48:AG49").Select
    ActiveSheet.Paste
    Sheets("Donnée").Select
    ActiveSheet.Protect Password:="magasin1234", DrawingObjects:=False, Contents:=True, Scenarios:= _
    False, AllowFormattingCells:=True
    Sheets("GABARIT").Select
    Range("B18:C19").Select
    ActiveSheet.Protect Password:="magasin1234", DrawingObjects:=False, Contents:=True, Scenarios:= _
    False, AllowFormattingCells:=True
End Sub

And same thing for "Case "": Application.Run "Fournisseur_ligne35" from 35 to (soon) 235

Private Sub Fournisseur_ligne35()

    Sheets("GABARIT").Select
    ActiveSheet.Unprotect Password:="magasin1234"
    
     Range("B4:F5").Select
    Selection.ClearContents
    
    Range("N4:R5").Select
    Selection.ClearContents
    
    Range("B8:F9").Select
    Selection.ClearContents
    
    Range("G8:M9").Select
    Selection.ClearContents
    
    Range("N8:R9").Select
    Selection.ClearContents
    
    Range("AC4:AG5").Select
    Selection.ClearContents
    
    Sheets("Donnée").Select
    ActiveSheet.Unprotect Password:="magasin1234"

    Range("G35").Select
    Selection.Copy
    Sheets("GABARIT").Select
    Range("B4:F5").Select
    ActiveSheet.Paste
    
    Sheets("Donnée").Select
    Range("F35").Select
    Selection.Copy
    Sheets("GABARIT").Select
    Range("N4:R5").Select
    ActiveSheet.Paste
    
    Sheets("Donnée").Select
    Range("C35").Select
    Selection.Copy
    Sheets("GABARIT").Select
    Range("B8:F9").Select
    ActiveSheet.Paste
    
    Sheets("Donnée").Select
    Range("B35").Select
    Selection.Copy
    Sheets("GABARIT").Select
    Range("G8:M9").Select
    ActiveSheet.Paste
    
    Sheets("Donnée").Select
    Range("E35").Select
    Selection.Copy
    Sheets("GABARIT").Select
    Range("N8:R9").Select
    ActiveSheet.Paste
    
    Sheets("Donnée").Select
    Range("H35").Select
    Selection.Copy
    Sheets("GABARIT").Select
    Range("AC4:AG5").Select
    ActiveSheet.Paste
    
    Sheets("Donnée").Select
    ActiveSheet.Protect Password:="magasin1234", DrawingObjects:=False, Contents:=True, Scenarios:= _
    False, AllowFormattingCells:=True
    Sheets("GABARIT").Select
    Range("B18:C19").Select
    ActiveSheet.Protect Password:="magasin1234", DrawingObjects:=False, Contents:=True, Scenarios:= _
    False, AllowFormattingCells:=True
End Sub

So i got like 30 requerant_ligne and like 200 fournisseur_ligne, do you have a way to shorten it. Because it's really a pain in the a** to do it 200 time copy paste... If i need to change the password, that would kill me to change it all.

If you need someting else to understand me, just tell me i would give you all your need.

I hope somebody got a way to do it, and thanks in advance. :cool::cool::cool:
Michellin
 
Last edited by a moderator:

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Sort by date Sort by votes
You can put the password in one lace & pass it to the subs like
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
   [COLOR=#ff0000]Dim Pw As String
   Pw = "magasin1234"[/COLOR]
If Not Intersect(Target, Range("AC10")) Is Nothing Then
        Select Case Range("AC10")
            Case "Francois Masse": Application.Run "Requerant_ligne2"[COLOR=#ff0000], "pw"[/COLOR]
and simplify the subs like
Code: 
Private Sub Requerant_ligne2(Pwrd As String)

    With Sheets("GABARIT")
      .Unprotect Password:=Pwrd
      .Range("B12:AG13,S48:AG49").ClearContents
   End With
   With Sheets("Donnée")
      .Unprotect Password:=Pwrd
      .Range("B2").Copy Sheets("GABARIT").Range("B12:F13")
      .Range("C2").Copy Sheets("GABARIT").Range("N12:AG13")
      .Range("D2").Copy Sheets("GABARIT").Range("G12:M13")
      .Range("E2").Copy Sheets("GABARIT").Range("S48:AG49")
      .Protect Password:=Pwrd, DrawingObjects:=False, Contents:=True, Scenarios:= _
         False, AllowFormattingCells:=True
   End With
    Sheets("GABARIT").Select
    Range("B18:C19").Select
    ActiveSheet.Protect Password:=Pwrd, DrawingObjects:=False, Contents:=True, Scenarios:= _
      False, AllowFormattingCells:=True
End Sub
 
Upvote 0
They keep asking me for capslock engage for the password
and in the :
Private Sub Requerant_ligne2(Pwrd As String)

With Sheets("GABARIT")
.Unprotect Password:=Pwrd
.Range("B12:F13,S48:AG49,N12:AG13,G12:M13").ClearContents
End With
With Sheets("Donnée")
.Unprotect Password:=Pwrd
.Range("B2").Copy Sheets("GABARIT").Range("B12:F13")
.Range("C2").Copy Sheets("GABARIT").Range("N12:AG13")
.Range("D2").Copy Sheets("GABARIT").Range("G12:M13")
.Range("E2").Copy Sheets("GABARIT").Range("S48:AG49")
.Protect Password:=Pwrd, DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True
End With
Sheets("GABARIT").Select
Range("B18:C19").Select
ActiveSheet.Protect Password:=Pwrd, DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True
End Sub

They bug me on the blue line. Maybe because you dim pw as string and here you use pwrd? I try to change it to pwrd and pw everywhere but something is not right.

Michellin
 
Upvote 0
You need to remove the quotes from pw on this line
Code: 
Application.Run "Requerant_ligne2", Pw
 
Upvote 0
Glad to help & thanks for the feedback.
 
Upvote 0
You must log in or register to reply here.

Similar threads

tlc53
  • Solved
Unprotect to run VBA - Why isn't it working??
Replies
1
Views
408
tlc53
tlc53
A
  • Solved
how to protect sheets vba code
2
Replies
19
Views
799
Scuba94
S
J
  • Question
Crashing Macro
2
Replies
12
Views
505
kevin9999
K
A
  • Question
I can't get private sub to run to update sheet name when the value in Cell A1 has changed
Replies
1
Views
319
duggie33
D
K
  • Solved
Insert Row Include Formulas - Protected Sheet
Replies
3
Views
328
Kirrash
K

Forum statistics

Threads
1,215,067
Messages
6,122,949
Members
449,095
Latest member
nmaske

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