Printable View
I'm trying to streamline my code by putting duplicate lines of code into a function or another sub. How would I do this?
For example: I have an IF..ELSEIF..THEN statement with many ELSEIF's. After each ELSEIF I would run the same 10 lines of code. I don't want to have the 10 lines of code under every ELSEIF section. I cannot have the 10 lines of code after the END IF line.
You have to post an example of what you are talking about.
You can see there are duplicate lines under each case statement. I just want to type those line once in my macro and call to it when needed. What is the best way to accomplish this?? (Sub, Class Module, Function....??)
Code:Case Is = "01680"
FindAfter = BaconWs.Range("C:C").Find("MWB").Address
If UCase(MasterWs.Range("S" & i)) Like "*CENTER*" Then
FoundRow = BaconWs.Range("C:C").Find("CENTER", BaconWs.Range(FindAfter)).Row + 2
ElseIf UCase(MasterWs.Range("S" & i)) Like "*NORTH*" Then
FoundRow = BaconWs.Range("C:C").Find("NORTH", BaconWs.Range(FindAfter)).Row + 2
ElseIf UCase(MasterWs.Range("S" & i)) Like "*SOUTH*" Then
FoundRow = BaconWs.Range("C:C").Find("SOUTH", BaconWs.Range(FindAfter)).Row + 2
Else
FoundRow = BaconWs.Range("C:C").Find(Dept).Row + 1
End If
BaconWs.Range("A" & FoundRow & ":X" & FoundRow).Insert
MasterWs.Range("B" & i & ":U" & i).Copy
BaconWs.Range("B" & FoundRow).PasteSpecial xlPasteValues
MasterWs.Range("W" & i & ":X" & i).Copy
BaconWs.Range("W" & FoundRow).PasteSpecial xlPasteValues
BaconWs.Range("V" & FoundRow) = "=U" & FoundRow
BaconWs.Range("A" & FoundRow).Interior.Color = vbGreen
Case Is = "01715"
FindAfter = BaconWs.Range("C:C").Find("PRECOOK").Address
If UCase(MasterWs.Range("S" & i)) Like "*NORTH*" Then
FoundRow = BaconWs.Range("C:C").Find("NORTH", BaconWs.Range(FindAfter)).Row + 2
ElseIf UCase(MasterWs.Range("S" & i)) Like "*WEST*" Then
FoundRow = BaconWs.Range("C:C").Find("WEST", BaconWs.Range(FindAfter)).Row + 2
ElseIf UCase(MasterWs.Range("S" & i)) Like "*EAST*" Then
FoundRow = BaconWs.Range("C:C").Find("EAST", BaconWs.Range(FindAfter)).Row + 2
ElseIf UCase(MasterWs.Range("S" & i)) Like "*SOUTH*" Then
FoundRow = BaconWs.Range("C:C").Find("SOUTH", BaconWs.Range(FindAfter)).Row + 2
Else
FoundRow = BaconWs.Range("C:C").Find(Dept).Row + 1
End If
BaconWs.Range("A" & FoundRow & ":X" & FoundRow).Insert
MasterWs.Range("B" & i & ":U" & i).Copy
BaconWs.Range("B" & FoundRow).PasteSpecial xlPasteValues
MasterWs.Range("W" & i & ":X" & i).Copy
BaconWs.Range("W" & FoundRow).PasteSpecial xlPasteValues
BaconWs.Range("V" & FoundRow) = "=U" & FoundRow
BaconWs.Range("A" & FoundRow).Interior.Color = vbGreen
Case Else
FoundRow = BaconWs.Range("C:C").Find(Dept).Row + 1
BaconWs.Range("A" & FoundRow & ":X" & FoundRow).Insert
MasterWs.Range("B" & i & ":U" & i).Copy
BaconWs.Range("B" & FoundRow).PasteSpecial xlPasteValues
MasterWs.Range("W" & i & ":X" & i).Copy
BaconWs.Range("W" & FoundRow).PasteSpecial xlPasteValues
BaconWs.Range("V" & FoundRow) = "=U" & FoundRow
BaconWs.Range("A" & FoundRow).Interior.Color = vbGreen
End Select
Here's a simplistic example of calling one sub from another:
Does that help?Code:Option Explicit
Sub MyMacro()
Dim i As Integer
Range("A1").Activate
Select Case ActiveCell.Value 'value of cell A1, here
Case 1
i = 45
Call MyOtherMacro(i) 'will call sub MyOtherMacro, passing the parameter i
Case 2
i = 6
Call MyOtherMacro(i) 'will call sub MyOtherMacro, passing the parameter i
Case 3
i = 50
Call MyOtherMacro(i) 'will call sub MyOtherMacro, passing the parameter i
Case 4
i = 5
Call MyOtherMacro(i) 'will call sub MyOtherMacro, passing the parameter i
Case 5
i = 13
Call MyOtherMacro(i) 'will call sub MyOtherMacro, passing the parameter i
End Select
End Sub
Sub MyOtherMacro(ByVal iColor As Integer)
Dim MyCell As Variant
For Each MyCell In Range("A:A")
With MyCell.Interior
.ColorIndex = iColor
.Pattern = xlSolid
End With
Next MyCell
End Sub
As it is in all of the Cases (including the Case Else), you should simply move it to after the End Select.
That will have exactly the same effect as you want, but take less effort and code, and also keep all of the code inside one routine (which makes it easier to maintain etc).
You should only move the code out of the routine if it is going to be used by multiple routines, or from multiple places in the same routine (the current situation is actually the same place).
elleg's code can be simplified a bit, the entire Select Case can be replaced by this:
..which makes using an extra Sub a bit redundant.Code:Select Case ActiveCell.Value 'value of cell A1, here
Case 1
i = 45
Case 2
i = 6
Case 3
i = 50
Case 4
i = 5
Case 5
i = 13
Case Else
Exit Sub 'dont run the following code for any other value
End Select
Call MyOtherMacro(i) 'will call sub MyOtherMacro, passing the parameter i
By the way Esham, I noticed you asked if there was a sub, function, class module, etc. that could address your issue. So, just for your information as to when you'd want to use each of those: functions cannot modify cells, they can only accept inputs and return a value. If you want something to run code that will modify cells, then a sub is your answer. Class modules are more complex, and I'd recommend finding an online tutorial to see how those work. For example: http://www.cpearson.com/Excel/Classes.aspx
Below is an example of a sub you could call that would do everything you have in your case statement above. As Si said, since you're repeating the same thing in each case statement, you could do what he said (using the Exit Sub statement), but you could still modify the code below. I can't recommend how, since I don't know what's in the rest of your code. I did debug the code as best I could without the rest of your code/your spreadsheet, but it is rough, and I'm sure there are ways to simplify/clarify it further.
Code:Sub YourMacro()
'add this variable to your Dim statements
Dim arrSearchTerms() As String 'string array, dynamic, can add the dimensions later
'where your code started in your example posted...
Case "01680"
'this array will contain your search terms, redim it to the size you need
ReDim arrSearchTerms(1 To 3)
arrSearchTerms(1) = "*CENTER*"
arrSearchTerms(2) = "*NORTH*"
arrSearchTerms(3) = "*SOUTH*"
Call OtherMacro("MWB", arrSearchTerms, i, Dept, False)
Case "01715"
ReDim arrSearchTerms(1 To 4)
arrSearchTerms(1) = "*NORTH*"
arrSearchTerms(2) = "*WEST*"
arrSearchTerms(3) = "*EAST*"
arrSearchTerms(4) = "*SOUTH*"
Call OtherMacro("PRECOOK", arrSearchTerms, i, Dept, False)
Case Else
'in the case else statement, this is really just a placeholder to satisfy the
'parameter requirements of the other sub, it won't actually be used
ReDim arrSearchTerms(1 To 1)
arrSearchTerms(1) = "Case Else"
'"ELSE" below is also a placeholder, it won't be used
Call OtherMacro("ELSE", arrSearchTerms, i, Dept, True)
End Select
End Sub
Sub OtherMacro(ByVal sAddy As String, ByRef sFindMe() As String, ByVal i As Integer, _
ByVal MyDept As Variant, ByVal bCaseElse As Boolean)
'---Variable Delcarations---------------------------------------------------------------------
Dim BaconWs As Worksheet
Dim MasterWs As Worksheet
Dim FindAfter As Variant
Dim sFindMeTrim As String
Dim FoundRow As Long
Dim v As Variant
Dim bFound As Boolean
'---Variable Initialization-------------------------------------------------------------------
Set BaconWs = ActiveWorkbook.Sheets("Bacon") 'change name to whatever your sheet's name is
Set MasterWs = ActiveWorkbook.Sheets("Master") 'change name to ...
'---Code--------------------------------------------------------------------------------------
If bCaseElse = False Then 'if it's not case else, run the normal code
FindAfter = BaconWs.Range("C:C").Find(sAddy).Address
'set boolean to determine if we found one of the search terms = false (not found) to start
bFound = False
For Each v In sFindMe() 'loop through the array of search terms, look for each one
sFindMeTrim = Replace(v, "*", "") 'corresponding range name
If UCase(MasterWs.Range("S" & i)) Like v Then
bFound = True 'if the search term is found, set the boolean to true
'your code below
FoundRow = BaconWs.Range("C:C").Find(sFindMeTrim, BaconWs.Range(FindAfter)).Row + 2
End If
Next v
End If
'if one of the search terms wasn't found / this is your case else statement
If bFound = False Or bCaseElse = True Then
'equivalent to your else statement -- your code below
FoundRow = BaconWs.Range("C:C").Find(MyDept).Row + 1
End If
'Your other code below
BaconWs.Range("A" & FoundRow & ":X" & FoundRow).Insert
MasterWs.Range("B" & i & ":U" & i).Copy
BaconWs.Range("B" & FoundRow).PasteSpecial xlPasteValues
MasterWs.Range("W" & i & ":X" & i).Copy
BaconWs.Range("W" & FoundRow).PasteSpecial xlPasteValues
BaconWs.Range("V" & FoundRow) = "=U" & FoundRow
BaconWs.Range("A" & FoundRow).Interior.Color = vbGreen
End Sub
Thanks for your help. I assume I need to declare my variables at the top to make them public?
I don't use Excel often (most of my VBA is in PowerPoint or Word), but I believe this is incorrect. I am able to use a function to modify cell values.Quote:
Originally Posted by elleg
Esham - Yes, to make the variable public, it would need to go where I've indicated below:
Mark - You're right, a function CAN modify a cell, however I don't generally use it for that since the main purpose I see for a function is to provide a value based on given inputs. Additionally, since functions can be called from worksheet cells (just like =SUM("A1:A5")), and a function called from a worksheet cannot modify any cells (or it just returns an error), I also prefer not to modify cells within a function. Generally you can use a Sub for anything where you need to modify cells. I suppose if there was a situation where you needed to modify cells and return a value, you could use a function to do that.Code:Option Explicit
'PUBLIC VARIABLES HERE---------------------------------------------------
Public MyPublicVariable as Variant
'SUBS GO HERE------------------------------------------------------------
Sub MySub()
'...
End Sub
'...