I need to shorten my macro.

M

michellin

Board Regular
Joined
Oct 4, 2011
Messages
57
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

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
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

N
  • Question Question
Adding to an existing MACRO
Replies
2
Views
125
Northern NY Design
N
M
  • Question Question
Add extra line of code to VBA to copy cell value across sheet
Replies
1
Views
76
myall_blues
myall_blues
N
  • Solved
Password Protection for a MACRO
2 3
Replies
23
Views
462
Northern NY Design
N
J
  • Question Question
Assistance changing VBA code to display as HTML or picture of a selection in Lotus Notes
Replies
2
Views
238
jularobert
J
M
  • Question Question
Prevent worksheet change from triggering when similar macro is executed?
Replies
1
Views
142
AlphaFrog
AlphaFrog

Forum statistics

Threads
1,224,823
Messages
6,181,176
Members
453,021
Latest member
Justyna P

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