Complicated multiple select case, variable declarations, range definitions - vba

Question

I developed the code below for a budget template I'm creating from scratch. The purpose is to populate automatically actual GL data information into my assumptions tab in the workbook. I'm using one particular month as a test. I have set up the assumptions tab to have about 26 different sections of regional office information in order to determine an appropriate forecast.
Not all GLs are itemized. I've lumped the GLs for a particular expense (other admin) in categories. I have about 5 major categories of spend and the rest of the GLs are considered as "other". Since the categories are not titled exactly the same as the GL accounts I've had to create a map grid on a separate tab in the workbook to link category names with different GLs.
The end goal is to:
Cycle through each category type on the assumptions tab for each PM region office,
Calculate the total amount for each spend (i.e., Evictions) by PM office plus it's cost center in another workbook,
Calculate the total amount for each spend of Entity code only items from that same other workbook.
The code below only cycle through and calculates the spend for Eviction GLs. I'm looking to improve the code for performance improvement, easier future maintenance(flexibility), and efficiency. The end goal is to cycle through the different types of spend. As of right now, my solution to do that is to repeat the variable/range declarations substituting EvictionRg for the next spend, as well as adding another case.
I'm afraid the code will get too long and performance may be at risk. Any insight and guidance as how I can plan this, modify the code, etc. to help me do this will be greatly appreciated. I've been at this for three days trying to figure it out by actually drawing a process map and other methods to help me brainstorm and by reading other posts on SO. I'm afraid I'm at the end of my VBA knowledge.
Sub Try()
'Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim Wb1 As Workbook
Dim Wb2 As Workbook
Set Wb1 = Workbooks("SubModel Forecast_Other Admin v4.xlsm")
Set Wb2 = Workbooks("Feb15 PNL.xlsx")
Dim Wk4 As Worksheet
Set Wk4 = Wb1.Sheets("ASSUMPTIONS")
Dim Wk5 As Worksheet
Set Wk5 = Wb1.Sheets("Validation")
Dim Wk7 As Worksheet
Set Wk7 = Wb1.Sheets("GL Mapping")
Dim Wk1 As Worksheet
Set Wk1 = Wb2.Sheets("det")
Dim fname As String
fname = "Feb15 PNL"
With Wb1 '----submodel
With Wk5 '---validation tab
Dim CCCol As Long
Dim fRowCC As Long
Dim lRowCC As Long
CCCol = Wk5.Cells.Find("Cost Center", lookat:=xlWhole).Column
fRowCC = Wk5.Cells.Find("Cost Center", lookat:=xlWhole).Offset(1, 0).row
lRowCC = Wk5.Cells.Find("Cost Center", lookat:=xlWhole).End(xlDown).row
'---Determine cost center code column range and it's corresponding Region Office Name(ClinkRg)
Dim CCRg As Range
Set CCRg = Wk5.Range(Wk5.Cells(fRowCC, CCCol), Wk5.Cells(lRowCC, CCCol))
Dim CLinkRg As Range
Set CLinkRg = Wk5.Range(Wk5.Cells(fRowCC, CCCol).Offset(0, -1), Wk5.Cells(lRowCC, CCCol).Offset(0, -1))
End With '----closes W5 Validation tab
'----Grid that contains GL accounts and their category type
With Wk7
Dim MapGLCol As Long
MapGLCol = Wk7.Cells.Find("GL", lookat:=xlWhole).Column
Dim MapfRow As Long
MapfRow = Wk7.Cells.Find("GL", lookat:=xlWhole).Offset(1, 0).row
Dim MaplRow As Long
MaplRow = Wk7.Cells(rows.Count, MapGLCol).End(xlUp).row
Dim MapGLRg As Range
Set MapGLRg = Wk7.Range(Wk7.Cells(MapfRow, MapGLCol), Wk7.Cells(MapfRow, MapGLCol))
Dim TypeRg As Range
Set TypeRg = Wk7.Range(Wk7.Cells(MapfRow, MapGLCol).Offset(0, -1), Wk7.Cells(MaplRow, MapGLCol).Offset(0, -1))
End With '--closes wk7 - GL Mapping
End With '--closes Wb1 - SubModel file
'---------PNL wkb
With Wb2
With Wk1
'If Left(Wk2.Name, 5) = "By PM" Then
Dim OpsCol As Long
OpsCol = Wk1.Cells.Find("Property Manager", lookat:=xlWhole).Column
'Else
' OpsCol = Wk1.Cells.Find("Submarket", lookat:=xlWhole).Column
'End If
Dim FRow As Long
Dim LRow As Long
'Dim ExpCol As Long
Dim PropCodeCol As Long
'Dim Expense As String
'Expense = InputBox("Enter Expense GL")
'to locate begining and ending row of data on PNL report
'Identifies the column where the SubMarket names are located for lookup purposes
'Defines the expense GL column to lookup based on the inputbox above
FRow = Wk1.Cells.Find("66990000", lookat:=xlPart).Offset(2, 0).row
LRow = Wk1.Cells.Find("66990000", lookat:=xlPart).End(xlDown).Offset(-1, 0).row
'ExpCol = Wk1.Cells.Find(Expense, lookat:=xlPart).Column
PropCodeCol = Wk1.Cells.Find("Property Code", lookat:=xlWhole).Column
'Defines the Range of the PM
Dim OpsRg As Range
Set OpsRg = Wk1.Range(Wk1.Cells(FRow, OpsCol), Wk1.Cells(LRow, OpsCol))
'Defines the Range of the Property Codes
Dim PropCodeRg As Range
Set PropCodeRg = Wk1.Range(Wk1.Cells(FRow, PropCodeCol), Wk1.Cells(LRow, PropCodeCol))
'Defines the exact range of the expense column being analyzed
'Dim ExpRg As Range
'Set ExpRg = Wk1.Range(Wk1.Cells(FRow, ExpCol), Wk1.Cells(LRow, ExpCol))
'Defining range for GLs under Other Admin
Dim GLRow As Long
Dim BegGLCol As Long
Dim EndGLCol As Long
GLRow = Wk1.Cells.Find("66550000", lookat:=xlPart).row
BegGLCol = Wk1.Cells.Find("66550000", lookat:=xlPart).Column
EndGLCol = Wk1.Cells.Find("66990000", lookat:=xlPart).Column
Dim GLRg As Range
Set GLRg = Wk1.Range(Wk1.Cells(GLRow, BegGLCol), Wk1.Cells(GLRow, EndGLCol))
'----Find All GL accounts in WB1 Wk5 Validation Tab range TypeRg categorized as Evictions($)
'----Then Look up each GL account in the row with all the GLs in the current workbook PNL and Wk1
'----------Set that up as TempCell
'----------Set the range for the entire column of data for each GL and consolidate as one range 'EvictionRg'
'----------Purpose of this is to set up one range for all GL accounts categorized as Eviction GL accoutns
Dim c As Range
For Each c In TypeRg
If c = "Evictions ($)" Then
Dim TempCell As Range
Set TempCell = GLRg.Find(c.Offset(0, 1).Value, lookat:=xlWhole)
'MsgBox (TempCell)
Dim EvictionRg As Range
If EvictionRg Is Nothing Then
Set EvictionRg = Wk1.Range(Wk1.Cells(FRow, TempCell.Column), Wk1.Cells(LRow, TempCell.Column))
Else
Set EvictionRg = Union(EvictionRg, Wk1.Range(Wk1.Cells(FRow, TempCell.Column), Wk1.Cells(LRow, TempCell.Column)))
End If
End If
Next c
'---Sum up all the amounts under all the GL eviction accounts and set them as "z"
Dim z As Double
z = Application.WorksheetFunction.Sum(EvictionRg)
'---Define Ranges for All Entities, Cost Centers, Entities Not Cost Centers
'Define the range on the Property PNL workbook all items booked under an entity
Dim AllEntRg As Range
Dim cell As Range
For Each cell In OpsRg
If cell = "" Then
If AllEntRg Is Nothing Then
Set AllEntRg = Wk1.Cells(cell.row, PropCodeCol)
Else
Set AllEntRg = Union(AllEntRg, Wk1.Cells(cell.row, PropCodeCol))
End If
End If
Next cell
'Define the range of the property PNL workbook that are Entity codes that are NOT Cost Center Codes
'---Entity Codes and Cost Center Codes are within the AllEntRg
'---Create a new range in the Eviction GL Range that intersects
'---------the rows of the entity only codes and the eviction GL columns
With AllEntRg
Dim EntityRg As Range
Dim cl As Range
For Each cl In AllEntRg
If CCRg.Find(cl.Value, lookat:=xlWhole) Is Nothing Then
Dim cl2 As Range
For Each cl2 In EvictionRg '------extra
If cl2.row = cl.row Then '------extra
If EntityRg Is Nothing Then
Set EntityRg = cl2
Else
Set EntityRg = Union(EntityRg, cl2)
End If
End If
Next cl2
End If
Next cl
'MsgBox (EntityRg.Address)
Dim v As Double
v = Application.WorksheetFunction.Sum(EntityRg)
End With
'With AllEntRg
'Dim CostCRg As Range
'Dim r As Range
'For Each r In AllEntRg
' If Not CCRg.Find(r.Value, lookat:=xlWhole) Is Nothing Then
' Dim cl3 As Range
' For Each cl3 In EvictionRg
' If cl3.row = r.row Then
' If CostCRg Is Nothing Then
' Set CostCRg = cl3
' Else
' Set CostCRg = Union(CostCRg, cl3)
' End If
' End If
' Next cl3
' End If
'Next r
'End With
'MsgBox (CostCRg.Address)
'Define cell ranges for regional PM offices that contain more than one cost center ocde
With AllEntRg
If Not AllEntRg.Find("cahied", lookat:=xlWhole) Is Nothing Then
Dim n As Range
Set n = AllEntRg.Find("cahied", lookat:=xlWhole)
End If
'MsgBox (n.Address)
If Not AllEntRg.Find("cahrvr", lookat:=xlWhole) Is Nothing Then
Dim n2 As Range
Set n2 = AllEntRg.Find("cahrvr", lookat:=xlWhole)
'MsgBox (n2.Address)
End If
If Not AllEntRg.Find("atlnw", lookat:=xlWhole) Is Nothing Then
Dim an1 As Range
Set an1 = AllEntRg.Find("atlnw", lookat:=xlWhole)
'MsgBox (an1.Address)
End If
If Not AllEntRg.Find("atln", lookat:=xlWhole) Is Nothing Then
Dim an2 As Range
Set an2 = AllEntRg.Find("atln", lookat:=xlWhole)
'MsgBox (an2.Address)
End If
If Not AllEntRg.Find("atlse", lookat:=xlWhole) Is Nothing Then
Dim ae1 As Range
Set ae1 = AllEntRg.Find("atlse", lookat:=xlWhole)
'MsgBox (ae1.Address)
End If
If Not AllEntRg.Find("atle", lookat:=xlWhole) Is Nothing Then
Dim ae2 As Range
Set ae2 = AllEntRg.Find("atle", lookat:=xlWhole)
'MsgBox (ae2.Address)
End If
If Not AllEntRg.Find("atlsw", lookat:=xlWhole) Is Nothing Then
Dim as1 As Range
Set as1 = AllEntRg.Find("atlsw", lookat:=xlWhole)
'MsgBox (as1.Address)
End If
If Not AllEntRg.Find("atls", lookat:=xlWhole) Is Nothing Then
Dim as2 As Range
Set as2 = AllEntRg.Find("atls", lookat:=xlWhole)
'MsgBox (as2.Address)
End If
End With
'---Create a new range in the Eviction GL Range that intersects
'---------the rows of the specific cost center codes and the eviction GL columns
If Not n Is Nothing Or Not n2 Is Nothing Then
Dim n3 As Range
For Each n3 In EvictionRg
If n3.row = n.row Or n3.row = n2.row Then
Dim InlandRg As Range
If InlandRg Is Nothing Then
Set InlandRg = n3
Else
Set InlandRg = Union(InlandRg, n3)
End If
End If
Next n3
End If
Dim n3v As Double
n3v = Application.WorksheetFunction.Sum(InlandRg)
If Not an1 Is Nothing Or Not an2 Is Nothing Then
Dim an3 As Range
For Each an3 In EvictionRg
If an3.row = an1.row Or an3.row = an2.row Then
Dim ATLNrg As Range
If ATLNrg Is Nothing Then
Set ATLNrg = an3
Else
Set ATLNrg = Union(ATLNrg, an3)
End If
End If
Next an3
End If
Dim an3v As Double
an3v = Application.WorksheetFunction.Sum(ATLNrg)
If Not ae1 Is Nothing Or Not ae2 Is Nothing Then
Dim ae3 As Range
For Each ae3 In EvictionRg
If ae3.row = ae1.row Or ae3.row = ae2.row Then
Dim ATLErg As Range
If ATLErg Is Nothing Then
Set ATLErg = ae3
Else
Set ATLErg = Union(ATLErg, ae3)
End If
End If
Next ae3
End If
Dim ae3v As Double
ae3v = Application.WorksheetFunction.Sum(ATLErg)
If Not as1 Is Nothing Or Not as2 Is Nothing Then
Dim as3 As Range
For Each as3 In EvictionRg
If as3.row = as1.row Or as3.row = as2.row Then
Dim ATLSrg As Range
If ATLSrg Is Nothing Then
Set ATLSrg = as3
Else
Set ATLSrg = Union(ATLSrg, as3)
End If
End If
Next as3
End If
Dim as3v As Double
as3v = Application.WorksheetFunction.Sum(ATLSrg)
End With '---closes Wk1 (PNL report)
End With '--closes wb2
''--------Cycle through the different PM regional office section (column) in assumptions tab
'---------Identify where Evictions ($) is located
'---------calculate total eviction GL amounts for each section (by Entity code only, by PM + cost center code)
With Wb1
With Wk4
Wk4.Outline.ShowLevels RowLevels:=2
Dim dateRow As Long
dateRow = Wk4.Cells.Find("ACT", lookat:=xlWhole).Offset(1, 0).row
Dim fRow2 As Long
Dim AssumCol As Long
Dim lRow2 As Long
fRow2 = Wk4.Cells.Find("Global Assumptions", lookat:=xlWhole).row
AssumCol = Wk4.Cells.Find("Global Assumptions", lookat:=xlWhole).Column
lRow2 = Wk4.Cells(rows.Count, AssumCol).End(xlUp).row
Dim AssumptionRg As Range
Set AssumptionRg = Wk4.Range(Wk4.Cells(fRow2, AssumCol), Wk4.Cells(lRow2, AssumCol))
Dim r2 As Range
Dim isItem As Boolean
For Each r2 In AssumptionRg
Select Case r2
Case "Evictions ($)"
isItem = True
Dim PM As Range
Set PM = r2.End(xlUp)
'---If PM Label is Entity Level, Inland Empire or is one of the Atlanta PMs then
'-----IF Entity Level, the sum up the Entity Range for the Evictions
'-----IF Inland Empire, sum up Inland Empire properties and Inland Empire Cost Center entries
'-----IF Atlanta, the sum up Atlanta PMs and their cost center entries individually
If PM = "Tie-Out To Actuals" Or PM = "Entity Level Assumptions" _
Or PM = "Inland Empire" Or PM = "Atlanta East" _
Or PM = "Atlanta North" Or PM = "Atlanta South" Then
If PM = "Tie-Out To Actuals" Then
Wk4.Cells(r2.row, 4) = z
End If
If PM = "Entity Level Assumptions" Then
Wk4.Cells(r2.row, 4) = v
End If
If PM = "Inland Empire" Then
Wk4.Cells(r2.row, 4).Formula = _
"=SUMPRODUCT(('[" & fname & ".xlsx]det'!" & OpsRg.Address & "=" & PM.Address & ")*'[" & fname & ".xlsx]det'!" & EvictionRg.Address & ")" _
& "+" & n3v
Wk4.Cells(r2.row, 4).Value = Wk4.Cells(r2.row, 4).Value
End If
If PM = "Atlanta East" Then
Wk4.Cells(r2.row, 4).Formula = _
"=SUMPRODUCT(('[" & fname & ".xlsx]det'!" & OpsRg.Address & "=" & PM.Address & ")*'[" & fname & ".xlsx]det'!" & EvictionRg.Address & ")" _
& "+" & ae3v
End If
If PM = "Atlanta North" Then
Wk4.Cells(r2.row, 4).Formula = _
"=SUMPRODUCT(('[" & fname & ".xlsx]det'!" & OpsRg.Address & "=" & PM.Address & ")*'[" & fname & ".xlsx]det'!" & EvictionRg.Address & ")" _
& "+" & an3v
End If
If PM = "Atlanta South" Then
Wk4.Cells(r2.row, 4).Formula = _
"=SUMPRODUCT(('[" & fname & ".xlsx]det'!" & OpsRg.Address & "=" & PM.Address & ")*'[" & fname & ".xlsx]det'!" & EvictionRg.Address & ")" _
& "+" & as3v
End If
Else
Dim CCCodeRow As Long
Dim CCCodeCol As Long
CCCodeRow = CLinkRg.Find(PM.Value, lookat:=xlWhole).Offset(0, 1).row
CCCodeCol = CLinkRg.Find(PM.Value, lookat:=xlWhole).Offset(0, 1).Column
If Wk5.Cells(CCCodeRow, CCCodeCol).Value = "None" Then
Wk4.Cells(r2.row, 4).Formula = _
"=SUMPRODUCT(('[" & fname & ".xlsx]det'!" & OpsRg.Address & "=" & PM.Address & ")*'[" & fname & ".xlsx]det'!" & EvictionRg.Address & ")"
Else
Wk4.Cells(r2.row, 4).Formula = _
"=SUMPRODUCT(('[" & fname & ".xlsx]det'!" & OpsRg.Address & "=" & PM.Address & ")*'[" & fname & ".xlsx]det'!" & EvictionRg.Address & ")" _
& "+SUMPRODUCT(('[" & fname & ".xlsx]det'!" & PropCodeRg.Address & "=" & "Validation!" & Wk5.Cells(CCCodeRow, CCCodeCol).Address & ")*'[" & fname & ".xlsx]det'!" & EvictionRg.Address & ")"
End If
End If
End Select
Next r2
Set r2 = Nothing
Set Wk4 = Nothing
End With '---closes assumptions tab
End With '---workbook2
'Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Answer 1

Whew, that is quite the read! Although I agree with Comintern, I do see a pretty simple solution to trimming up your code, and making it easier to maintain.
I don't see a single function in the entire thing. If you're writing scripts that long, and not using them, you need to start... They'll change your life.
Lets take a simple block that I see repeated several (8) times. Note that I see several much larger blocks that are repeated throughout, but this one will be easy to learn on.
If Not AllEntRg.Find("atlsw", lookat:=xlWhole) Is Nothing Then
Dim as1 As Range
Set as1 = AllEntRg.Find("atlsw", lookat:=xlWhole)
End If
I only see three things that change from if to if in this part of the code, 2 on the input side are a range and a string, and it outputs a range if conditions are met. So you write a function like this, and place it somewhere in any module in the same workbook.
Public Function DefMultiCCPMRange(rngSearchRange as range, strSearchString as string)as range
If Not AllEndRg.Find(strSearchString, lookat:=xlWhole) Is Nothing Then
set DefMultiCCPMRange = rngSearchRange.Find(strSearchString, Lookat:=xlWhole)
End If
End Function
Now instead of rewriting this over and over.
If Not AllEntRg.Find("atlsw", lookat:=xlWhole) Is Nothing Then
Dim as1 As Range
Set as1 = AllEntRg.Find("atlsw", lookat:=xlWhole)
End If
You write this over and over.
Dim as1 as Range
set as1 = DefMultiCCPMRange(AllEndRg,"atlsw")
Also the lifetime of the variables that are used in the function, ends when the function ends, so your not storing every variable you use in memory for the entire duration of runtime.
That should take you a long way if you play with it.
I would also look into Arrays, Collections, and Dictionary items. They'll change your life too once you see where their power really lies. You could get creative and instead of declaring and setting that range 8 times, you could do a for loop, and put them all in one object named for the CC Code.
Dim arrCCCodes(3) as string 'change to arrCCCodes(7) for your 8 codes
arrCCCodes(0) = "cahied"
arrCCCodes(1) = "cahrvr"
arrCCCodes(2) = "atlnw"
arrCCCodes(3) = "atln"
'etc...
'add a reference to Microsoft scripting runtime
Dim odicCCRanges as New Dictionary
For i = 0 to UBound(arrCCCodes)
odicCCRanges.Add arrCCCodes(i), DefMultiCCPMRange(AllEndRg, arrCCCodes(i))
next
This will give you a dictionary object with 4 ranges in it (would be 8 in your actual code), not to mention lose a couple pages of code. You would call the values in the range like odicCCRanges("cahied").Item(1) or odicCCRanges(arrCCCodes(0)).Item(1). Here's where it adds to your project lifetime. If you need to add a new CC, you just change the arrCCCodes declaration to include one more item, then add it below, and the rest of our code will automatically pick it up, run the define ranges function, and add it to the dictionary.
Your code doesn't look all that bad, your testing for nulls, and declaring your vars, all good stuff. It's just all series scripted. Try stepping through your code, and watching the locals window in the VBA IDE. Particularly expand a range node after its set. It'll blow your mind what is actually in a Range Object.

Answer 2

You obviously have a lot of time invested in this but I really think you are over complicating things. Since all your code is doing is building ranges and then summing them I'm thinking you could do this with array formulas.