run multiple macros from drop down list

M

markrennolds

Hi All

I have various macro's that all work correctly when run independently
I want to run the correct macro for a certain area i.e. North West, whe
it is selected from a drop down menu in B2.

I have had some advice already & have got the following macr
"copyregion" which should act as a control macro. When i run the macr
it errors on the paste element of the macro.

I like the fact that there is 1 control macro as I do have othe
macro's to add later which again I can control through the contro
macro.

I need some help with 2 points:
1) Making the "copy region" macro work
2) Linking that macro to the drop down menu in B2.

Thanks in advance
Mark


Code
-------------------
Option Explicit
Sub CopyRegion()
'Select and copy correct range
Select Case Range("B2").Value
Case "Northwest"
Sheets("Input Drop").Range("B73:B93").Copy
Case "M62corridor"
Sheets("Input Drop").Range("B22:B41").Copy
Case "M1corridor"
Sheets("Input Drop").Range("B6:B20").Copy
Case "Northeast"
Sheets("Input Drop").Range("B43:B59").Copy
Case "NorthernIreland"
Sheets("Input Drop").Range("B61:B71").Copy
Case "Scotland1"
Sheets("Input Drop").Range("B95:B114").Copy
Case "Scotland2"
Sheets("Input Drop").Range("B116:B131").Copy
End Select

'Paste
Sheets("Area Summary").Range("B8").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'Sort
Sheets("Area Summary").Range("B7:M28").Select
Application.CutCopyMode = False

With ActiveWorkbook.Worksheets("Area Summary").Sort
.SortFields.Clear
.SortFields.Add Key:=Range("M8:M28"), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range("E8:E28"), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
.SetRange Range("B7:M28")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Range("B7").Select
End Sub
Sub NorthWest()
'
' NorthWest Macro
'

'
Sheets("Input Drop").Select
Range("B73:B93").Select
Selection.Copy
Sheets("Area Summary").Select
Range("B8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B7:M28").Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Area Summary").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Area Summary").Sort.SortFields.Add Key:=Range( _
"M8:M28"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Area Summary").Sort.SortFields.Add Key:=Range( _
"E8:E28"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Area Summary").Sort
.SetRange Range("B7:M28")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B7").Select
End Sub
Sub M62corridor()
'
' M62corridor Macro
'

'
Sheets("Input Drop").Select
ActiveWindow.SmallScroll Down:=-63
Range("B22:B41").Select
Selection.Copy
Sheets("Area Summary").Select
Range("B8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B28").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("B7:M28").Select
ActiveWorkbook.Worksheets("Area Summary").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Area Summary").Sort.SortFields.Add Key:=Range( _
"M8:M28"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Area Summary").Sort.SortFields.Add Key:=Range( _
"E8:E28"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Area Summary").Sort
.SetRange Range("B7:M28")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B7").Select
End Sub

Sub M1corridor()
'
' M1corridor Macro
'

'
Sheets("Input Drop").Select
Range("B6:B20").Select
Selection.Copy
Sheets("Area Summary").Select
Range("B8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B23:B28").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("B7:M28").Select
ActiveWorkbook.Worksheets("Area Summary").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Area Summary").Sort.SortFields.Add Key:=Range( _
"M8:M28"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Area Summary").Sort.SortFields.Add Key:=Range( _
"E8:E28"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Area Summary").Sort
.SetRange Range("B7:M28")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B7").Select
End Sub
Sub Northeast()
'
' Northeast Macro
'

'
Range("B8").Select
Sheets("Input Drop").Select
ActiveWindow.SmallScroll Down:=9
Range("B43:B59").Select
Selection.Copy
Sheets("Area Summary").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B25:B28").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("B7:M28").Select
ActiveWorkbook.Worksheets("Area Summary").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Area Summary").Sort.SortFields.Add Key:=Range( _
"M8:M28"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Area Summary").Sort.SortFields.Add Key:=Range( _
"E8:E28"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Area Summary").Sort
.SetRange Range("B7:M28")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B7").Select
End Sub
Sub NorthernIreland()
'
' NorthernIreland Macro
'

'
Range("B8").Select
Sheets("Input Drop").Select
Range("B61:B71").Select
Selection.Copy
Sheets("Area Summary").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B19:B28").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("B7:M28").Select
ActiveWorkbook.Worksheets("Area Summary").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Area Summary").Sort.SortFields.Add Key:=Range( _
"M8:M28"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Area Summary").Sort.SortFields.Add Key:=Range( _
"E8:E28"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Area Summary").Sort
.SetRange Range("B7:M28")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B7").Select
End Sub
Sub Scotland1()
'
' Scotland1 Macro
'

'
Range("B8").Select
Sheets("Input Drop").Select
Range("B95:B114").Select
Selection.Copy
Sheets("Area Summary").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B28").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("B7:M28").Select
ActiveWorkbook.Worksheets("Area Summary").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Area Summary").Sort.SortFields.Add Key:=Range( _
"M8:M28"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Area Summary").Sort.SortFields.Add Key:=Range( _
"E8:E28"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Area Summary").Sort
.SetRange Range("B7:M28")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B7").Select
End Sub
 
J

Joel

I suspect you aren't finding a region. There is nothing in the Paste
clipboard so the code is failing when you try to do a paste sopecial. I
added some error checking code below. I only including the section of the
code that need to be changed.


Option Explicit
Sub CopyRegion()
Dim Found as boolean
Dim Region

Found = True
Region = Range("B2").Value
'Select and copy correct range
Select Case Region

Case "Northwest"
Sheets("Input Drop").Range("B73:B93").Copy
Case "M62corridor"
Sheets("Input Drop").Range("B22:B41").Copy
Case "M1corridor"
Sheets("Input Drop").Range("B6:B20").Copy
Case "Northeast"
Sheets("Input Drop").Range("B43:B59").Copy
Case "NorthernIreland"
Sheets("Input Drop").Range("B61:B71").Copy
Case "Scotland1"
Sheets("Input Drop").Range("B95:B114").Copy
Case "Scotland2"
Sheets("Input Drop").Range("B116:B131").Copy
Case Else
Found = False
End Select

if Found = False then
msgbox("Could not find region : " & Region & _
vbcrlf & "Exiting Macro")
end if'

'Paste
Sheets("Area Summary").Range("B8").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
M

markrennolds

Hi Joel

Thanks for your help. Unfortunately it is still not working. The macr
does not run automatically off B2, and when i do run it an error come
up saying "M1Corridor" not found etc.

I have pasted the changes straight into both the individual worksheet
the full workbook. Not sure what to do next as I'm new to macro's?

Spreadsheet attached if you wouldnt mind having a look?

Thanks
Mark

18

+-------------------------------------------------------------------
|Filename: Advanced Estate KPI Tool Area.xls
|Download: http://www.thecodecage.com/forumz/attachment.php?attachmentid=185
+-------------------------------------------------------------------
 
J

Joel

No need to send the workbook. We found the problem. The error message gave
me the clue. The region name in the pulldown and the region name in the case
statement is not exactly the same. Look closely. Try this code below.

Option Explicit
Sub CopyRegion()
Dim Found as boolean
Dim Region

Found = True
Region = Range("B2").Value
'Select and copy correct range
Select Case UCASE(Region)

Case "NORTHWEST"
Sheets("Input Drop").Range("B73:B93").Copy
Case "M62CORRIDOR"
Sheets("Input Drop").Range("B22:B41").Copy
Case "M1CORRIDOR"
Sheets("Input Drop").Range("B6:B20").Copy
Case "CORRIDOR"
Sheets("Input Drop").Range("B43:B59").Copy
Case "NORTHERNIRELAND"
Sheets("Input Drop").Range("B61:B71").Copy
Case "SCOTLAND1"
Sheets("Input Drop").Range("B95:B114").Copy
Case "SCOTLAND2"
Sheets("Input Drop").Range("B116:B131").Copy
Case Else
Found = False
End Select

if Found = False then
msgbox("Could not find region : " & Region & _
vbcrlf & "Exiting Macro")
end if'
 
M

markrennolds

Hi Joel

I have tried that & still no luck. I have also copied the text exactl
into the macro as it appears on the drop down, and still doesnt find th
info.

Mar
 
J

Joel

We found the problem. The two strings aren't matching that is why we are
getting to the CASE ELSE. There may be spaces at the beginning or end of the
string.

try
trim(UCASE(Region))

Another trick I use is to get the length of the two strings

msgbox(len(Region))


You can upload your code to CodeCage and I will look at it, but the problem
is the strings don't match.
 
M

markrennolds

Hi Joel

There were spaces before the text so was throwing out the macro. Hav
sorted that now & macro works fine.
However it is not running automatically from the drop down in B2, onl
when i run it from the macro menu.

Any idea's?

Thanks
Mark

18

+-------------------------------------------------------------------
|Filename: Advanced Estate KPI Tool Area.xls
|Download: http://www.thecodecage.com/forumz/attachment.php?attachmentid=186
+-------------------------------------------------------------------
 
J

Joel

I don't like the selection method in the code you have. but don't think tha
is the problem. I'm not usre how you are running the code.

I think this statment may be the problem

Region = Range("B2").Value

There is no sheet reference. You have the same code in VBA sheet "Area
Summary" and in Module3. If you are running the code from the worksheet
Macro menu you are calling the module3 code. The activesheet will be the
sheet that will be used to get REGION. Since your code is switching actrive
sheets using selection I'm not sure which sheet is the activesheet. You get
my point!!!!


I wouldn't put the same code in two places. You can call code in the module
sheet from the the "Area Summary" sheet. Not usre why you have any code in
the "Area Summary" sheet.
 
M

markrennolds

Sorry Joel

I understand what is wrong but dont know how to sort it out.
appreciate your help, couldn't have got that far by myself.

Can anyone help me out please? I just need to understand how to run th
"copyregion" macro by using the dropdown in B2?
It works when I run it from the macro menu, so just need the code t
look at B2 in "Area Summary" sheet and run the "copyregion" macro.

Thanks
Mark

18

+-------------------------------------------------------------------
|Filename: Advanced Estate KPI Tool Area.xls
|Download: http://www.thecodecage.com/forumz/attachment.php?attachmentid=187
+-------------------------------------------------------------------
 
J

Joel

I'm not usre I understand your problem. The code works for me. If you want
the code to run automatically whenyou change the drop down box put this code
in the VBA "Area Summary" sheet. I removed all the other code in this sheet.
Didn't need two copies of the code.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B2")) Is Nothing Then
Call CopyRegion
End If
End Sub
 
J

Joel

I'm not usre I understand your problem. The code works for me. If you want
the code to run automatically whenyou change the drop down box put this code
in the VBA "Area Summary" sheet. I removed all the other code in this sheet.
Didn't need two copies of the code.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B2")) Is Nothing Then
Call CopyRegion
End If
End Sub
 
M

markrennolds

Thanks Joel

All runs from drop down now. I have tried to put a 'clear contents
rule in before the 'paste' rule as any previous data still in the tabl
is left in there.
I copied this from the macro's I had recorded for the individual area'
but isn't working in this instance.

Sorry to be a nuisance but do you know why?

Thanks
Mark


Code
 
J

Joel

The clear unselects the copy range. I moved the clear to the beginning of
the sub

Option Explicit
Sub CopyRegion()
Dim Found As Boolean
Dim Region

Sheets("Area Summary").Range("B8:B28").Select
Application.CutCopyMode = False
Selection.ClearContents


Found = True
Region = Range("B2").Value
'Select and copy correct range
Select Case (Region)

Case "North West"
Sheets("Input Drop").Range("B73:B93").Copy
Case "M62 Corridor"
Sheets("Input Drop").Range("B22:B41").Copy
Case "M1 CORRIDOR"
Sheets("Input Drop").Range("B6:B20").Copy
Case "North East"
Sheets("Input Drop").Range("B43:B59").Copy
Case "Northern Ireland"
Sheets("Input Drop").Range("B61:B71").Copy
Case "Scotland1"
Sheets("Input Drop").Range("B95:B114").Copy
Case "Scotland2"
Sheets("Input Drop").Range("B116:B131").Copy
Case Else
Found = False
End Select

If Found = False Then
MsgBox ("Could not find region : " & Region & _
vbCrLf & "Exiting Macro")
End If '



'Paste
Sheets("Area Summary").Range("B8").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False


'Sort
Sheets("Area Summary").Range("B7:M28").Select
Application.CutCopyMode = False

With ActiveWorkbook.Worksheets("Area Summary").Sort
.SortFields.Clear
.SortFields.Add Key:=Range("M8:M28"), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range("E8:E28"), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
.SetRange Range("B7:M28")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Range("B7").Select
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

macro works at home but not at work 1
Modify Sort Routine to inlcude All Data 2
Undo Macro Action 3
Sorting Question 5
VBA 2 Codes 2
Clear Check Box 2
Pictures not being sorted in VBA 2
Stay on Active Sheet 2

Top