Help making a macro shorter & dynamic

TempoTours

Board Regular
Joined
Aug 23, 2007
Messages
89
Hello, I have the following code as part of my macro. What I was wondering is a) Can anyone think of a way to shorten this? and b) I currently have this exact code copied 8 times, I did a find and replace to change 'if year = 2003 then' to the year 2010. What I would like is to have 1 code that will automatically change depending on the year the user inputs in a cell. (I should mention that 'Year' is a cell on my input sheet where the user types in the year they are currently working on and the macro automatically runs)

Code:
'2003
    Sheets("Cash Crops").Select
    If Year = 2003 Then
' This copies the cash crop BPU's.
    ActiveSheet.Unprotect
    Workbooks.Open Filename:="F:\xdata\CAIS\CAIS spreadsheets\BPU's.xls"
    Application.Goto reference:="Cash03"
    Selection.Copy
    Windows(Filename).Activate
    ActiveWindow.SmallScroll Down:=21
    Application.Goto reference:="CashCrops"
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-30
    Range("A2").Select
    Application.CutCopyMode = False
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
' This copies the livestock BPU's
    Sheets("Livestock").Select
    ActiveWindow.ScrollRow = 1
    ActiveSheet.Unprotect
    Windows("BPU's.xls").Activate
    Application.Goto reference:="Live03"
    Selection.Copy
    Windows(Filename).Activate
   Application.Goto reference:="Livestock"
    ActiveSheet.Paste
    Range("A3").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
' This copies the supply managed cash crops BPU's.
    Sheets("Sup Cash Crops").Select
    ActiveSheet.Unprotect
    Windows("BPU's.xls").Activate
    Application.Goto reference:="SupCash03"
    Selection.Copy
    Windows(Filename).Activate
    Application.Goto reference:="SupCashCrops"
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("B18").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
' This copies the supply managed livestock BPU's.
    Sheets("Sup Livestock").Select
    ActiveSheet.Unprotect
    Windows("BPU's.xls").Activate
    Application.Goto reference:="SupLive03"
    Selection.Copy
    Windows(Filename).Activate
    ActiveWindow.SmallScroll Down:=24
    Application.Goto reference:="suplivestock"
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-33
    Range("A3").Select
    Application.CutCopyMode = False
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("Cash Crops").Select
    Range("A2").Select
    Windows("BPU's.xls").Activate
    ActiveWindow.Close

Any help/thoughts would be appreciated, thanks
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
The first thing I'd do is get rid of all that screen navigation crap (ActiveWindow.SmallScroll Down:=-33), as it's useless. (I take that back. It does have a purpose: to slow down your code. :unsure:)

Second, I'd trap the user input and use it throughout:

Code:
Dim i As Long
        i = Sheets("Cash Crops").Range("Year")

With that you can substitute i for the year and end up with one set of code. Along those lines I'd suggest using a Data Validation list to house your years, instead of having users key them in. You can also use a change event to call your code once a list year has been selected.

The protection portion can be shortened as well:

Code:
ActiveSheet.Protect

The True statemensts are implied, so you only need to include those conditions you want to set to false.

As to all of your application calls, you can nest that (and get rid of CutCopyMode = False until the end, you only need to release it 1x), and you should add ScreenUpdating:

Code:
With Application
  .ScreenUpdating = False

  '  do something

  '.Goto Reference can be within the nest as well

  .ScreenUpdating = Tre
  .CutCopyMode = False
End WIth

WIth your goto's I'd try
Code:
Range("SupLive03").Copy

The more you can eliminate selection, goto, activation the better.

I.E. This:

Code:
Range("A1").COpy Range("B1")

can replace
Code:
Range("A1").Select
Selection.Copy
Range(""B1").Select
Activesheet.paste

Phew...That oughtta get you started. ;)

Smitty
 
Upvote 0
Thanks for the tips...I'll keep that in mind, however I am having little trouble fully understanding how I recode the macro for the this section:
Second, I'd trap the user input and use it throughout:

Code:
Code:
Dim i As Long 
        i = Sheets("Cash Crops").Range("Year")

With that you can substitute i for the year and end up with one set of code. Along those lines I'd suggest using a Data Validation list to house your years, instead of having users key them in. You can also use a change event to call your code once a list year has been selected

Does this mean I get rid of
Code:
If Year = 2003 Then
and substitue with the above? If so, just to double check, the actual cell that the year goes in is named 'Year' and is on a sheet labeled 'Input', therfore the code should be
Code:
 i=sheets("Input").Range("Year")
? If I change that, how do I get the program to the correct "SupCash(xx)" in the BPU list..it's "SupCash03" for the 2003 year, "SupCash04" for the 2004 year, etc.
 
Upvote 0
TempoTours

I don't think that's quite what's being suggested.

All I think Smitty is saying is to populate a variable, i, with the year.

But it's hard to tell exactly how you would use that without seeing more code.

It might be used like this.
Code:
Application.Goto reference:="Cash" & Mid(CStr(i), 3)
But as has been suggested it would probably a good idea to lose the Gotos.

Another thing I would recommend was removing the multiple protection code.

You should only really need one at the end of the code.
 
Upvote 0
All I think Smitty is saying is to populate a variable, i, with the year.

You got it.

In addition to what Norie posted, I was also imagining referring to this:

Code:
Range("SupLive03").Copy

dynamically like this:

Code:
Range("SupLive0" & i).Copy

Smitty
 
Upvote 0
Ok, this is what I have changed the first part of my code to....needless to say, it's not working. I'm sorry, I used to think I was pretty good at writing macros, but apparently not. For one, how to I get the variable 'i' to change to the correct year I want? I think, since I have my ranges on the BPU spreadsheet labeled as 'CashCrops03' for the 2003 year, etc. Should 'i' be equal to Year, and then change the code to 'Range("CashCrops"&i) and then change by range in the BPU spreadsheet to 'CashCrops2003'?

Code:
Sub BPU1()
'
' BPU1 Macro
' Macro recorded 10/29/2005 by MichaelV to update the BPU's.
'
'
Application.ScreenUpdating = False

Dim Filename As String
Dim MonthEnd As String
Dim Year As Integer
Dim i As Long
Filename = ThisWorkbook.Name

MonthEnd = MsgBox("Is your month end between January 1 and June 30?", vbYesNoCancel, "Month Ending")
If MonthEnd = vbYes Then
Year = range("Year") - 1
ElseIf MonthEnd = vbNo Then
Year = range("Year")
Else
End
End If
        

' This copies the cash crop BPU's.
    Sheets("Cash Crops").Select
    ActiveSheet.Unprotect
    Workbooks.Open Filename:="F:\xdata\CAIS\CAIS spreadsheets\BPU's.xls"
    range("Cash0" & i).Copy range("CashCrops")
    range("A2").Select
    ActiveSheet.Protect
' This copies the livestock BPU's
    Sheets("Livestock").Select
    ActiveSheet.Unprotect
    range("Live0" & i).Copy range("Livestock")
    range("A3").Select
    ActiveSheet.Protect' This copies the supply managed cash crops BPU's.
    Sheets("Sup Cash Crops").Select
    ActiveSheet.Unprotect
    range("SupCashCrops0" & i).Copy range("SupCashCrops")
    range("B18").Select
    ActiveSheet.Protect
' This copies the supply managed livestock BPU's.
    Sheets("Sup Livestock").Select
    ActiveSheet.Unprotect
    range("SupLive0" & i).Copy range("SupLivestock")
    range("A3").Select
    ActiveSheet.Protect
    Sheets("Cash Crops").Select
    range("A2").Select
    Windows("BPU's.xls").Activate
    ActiveWindow.Close
' This goes back to the input spreadsheet and stops at the partnership percentage.
    Application.CutCopyMode = False
    Application.Goto reference:="Owner"
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Sorry but I don't see where you are actually setting a value for i anywhere.:eek:

By the way you really shouldn't use a variable name like Year, that's a VBA function.
 
Upvote 0
That's what I was trying to ask...how do I set the value for i? The ranges in the BPU spreadsheet are also dependant on years, ie the range B5:G19 (labeled as 'Cash03') is for the 2003 year, range C5:H19 (labeled as 'Cash04') is for the 2004 year, etc. The macro has to understand that if the 2003 is entered, grab 'Cash03' from the BPU spreadsheet, and if 2004 is entered 'Cash04' is selected, that seems to be my biggest problem right now
BTW, the original macro I had recorded only took 1/10 of a second to operate, so I'm not sure how the small scrolls are affecting speed. It makes it look neater and easier to read, which is good (and something I'd like to accomplish). So, thanks for the other tips on making the code shorter, and I'll remember the Year range for next time Norie, thanks
 
Upvote 0
I think you'll want to set i = to the year, not "Year" (also not that Year is a VBA function, and you can get conflicts using it):

Here's a quick rewrite (obviously not tested):

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> BPU1()
    <SPAN style="color:#00007F">Dim</SPAN> Filename <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, MonthEnd <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> Year <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    
    Filename = ThisWorkbook.Name
    
    <SPAN style="color:#00007F">With</SPAN> Application
        .ScreenUpdating = <SPAN style="color:#00007F">False</SPAN>
    
        MonthEnd = MsgBox("Is your month end between January 1 and June 30?", vbYesNoCancel, "Month Ending")
            <SPAN style="color:#00007F">If</SPAN> MonthEnd = vbYes <SPAN style="color:#00007F">Then</SPAN>
                i = Range("Year") - 1
            <SPAN style="color:#00007F">ElseIf</SPAN> Month<SPAN style="color:#00007F">End</SPAN> = vbNo <SPAN style="color:#00007F">Then</SPAN>
                i = Range("Year")
            <SPAN style="color:#00007F">Else</SPAN>
                <SPAN style="color:#00007F">End</SPAN>
            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
                
        <SPAN style="color:#007F00">' This copies the cash crop BPU's.</SPAN>
            <SPAN style="color:#00007F">With</SPAN> Sheets("Cash Crops")
                .Unprotect
                    Workbooks.Open Filename:="F:\xdata\CAIS\CAIS spreadsheets\BPU's.xls"
                    Range("Cash0" & i).Copy Range("CashCrops")
                .Protect
            End <SPAN style="color:#00007F">With</SPAN></FONT>

Smitty
 
Upvote 0
I get a run time error '1004':
Method 'Range' of object '_Global' failed
error on the line
Code:
Range("Cash0" & i).Copy Range("CashCrops")
I am assume the out put for the Range - Range("Cash0" & i) would be equal to Range("Cash02003") if the user entered 2003 in the input cell (as this would make i=2003) correct? Therefore, since on my BPU sheet, the range is actually labeled "Cash2003", I dropped the 0 after cash, however, either way, I get the same error
 
Upvote 0

Forum statistics

Threads
1,213,563
Messages
6,114,329
Members
448,564
Latest member
ED38

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