folks, trouble with inherited workbooks is that while the original macro author is around, things tend to have to be run their way. the workbook i am currently adding to is a consolidation of different financial systems. it ultimately creates the "one source of truth". The analyst that created it has done a great job but tends to use "select" a little too much for my liking . I am hoping that some generous forum users will help me clean it up a little.
The worksheet contains sales information in 4 tables. These four tables lookup the raw data imports from the different systems. The totals table is at the top of the worksheet. the three tables beneath the totals table contain extra rows (containing formulas but currently empty) underneath the current data to enable further expansion. These extra rows are hidden. Each table has a named range as a start point and a named range as an end point. the extra rows are also inside the start and end named range.
There are three drop down boxes - Country, Territory, Area - each of which fires the sheet change event.
Selection from drop down boxes two (Territory) and three (Area) are dependent upon the higher level choice. That is if Territory 5 is selected, only the Areas within Territory 5 are available for selection in drop down box three (Area).
The lookup formulas contained in the rows of each of the three tables on the worksheet will only return data based on the selection made in the drop down. so the number of "empty" rows at the end of each table changes each time a selection is made.
The event code follows the same format, when a selection is made, unhide all rows within each table between the starting named range and the ending named range. then rehide unused rows (depends upon the selection).
Can anyone suggest a better way to write this event or any part of it without changing the ultimate effect of displaying the results for the selections made?
as an addendum, I have created another macro which uses this event change to run each of the Territories reports (it loops through a list and changes the value of the Territory dropdown then copies/pastes the results to a seperate workbook, territory by territory)
The combination of the two is really slow.
The worksheet contains sales information in 4 tables. These four tables lookup the raw data imports from the different systems. The totals table is at the top of the worksheet. the three tables beneath the totals table contain extra rows (containing formulas but currently empty) underneath the current data to enable further expansion. These extra rows are hidden. Each table has a named range as a start point and a named range as an end point. the extra rows are also inside the start and end named range.
There are three drop down boxes - Country, Territory, Area - each of which fires the sheet change event.
Selection from drop down boxes two (Territory) and three (Area) are dependent upon the higher level choice. That is if Territory 5 is selected, only the Areas within Territory 5 are available for selection in drop down box three (Area).
The lookup formulas contained in the rows of each of the three tables on the worksheet will only return data based on the selection made in the drop down. so the number of "empty" rows at the end of each table changes each time a selection is made.
The event code follows the same format, when a selection is made, unhide all rows within each table between the starting named range and the ending named range. then rehide unused rows (depends upon the selection).
Rich (BB code):
Private Sub Worksheet_Change(ByVal target As Range)
'Declare Variables
Dim KeyCells1 As Range '*****DRopDown Box 1
Dim KeyCells2 As Range '*********DRopDown Box 2
Dim KeyCells3 As Range '*********DRopDown Box 3
Dim KeyCells4 As Range '*********???not used
Dim KeyWord As String
Set KeyCells1 = Range("SelectCountry") '****value of DRopDown Box 1
Set KeyCells2 = Range("SelectTerritory") '******value of DRopDown Box 2
Set KeyCells3 = Range("SelectCluster") '*****value of DRopDown Box 3
KeyWord = Application.Range("varKeyword") ' ********keyword is ALL
'If country is selected
If Not Application.Intersect(KeyCells1, Range(target.Address)) _
Is Nothing Then
'Freeze Screen
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Update Selections to All
Range("SelectTerritory") = KeyWord
Range("SelectCluster") = KeyWord
'Unhide rows (********unhides all rows between the two named ranges)
Range("AutohideStoreStart", "AutohideStoreEnd").Select
Selection.EntireRow.Hidden = False
'Find end of report (******once all rows visible, finds first empty cell)
Range("Autohidestorestart").Select
Do Until ActiveCell = ""
ActiveCell.Offset(1, 0).Select
Loop
'Hide Rows (***********select from first empty cell to bottom of section)
Range(ActiveCell, Selection.End(xlDown)).Select
Selection.EntireRow.Hidden = True
'returning to change cell
Range("SelectCountry").Select
End If
'If Territory is selected
If Not Application.Intersect(KeyCells2, Range(target.Address)) _
Is Nothing Then
'Freeze Screen
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Unhide Top 5 Rows (********unhides table for top and bottom performers - selects named range at top of and named range at bottom of section and unhides)
Range("AutohideStoreStart2", "AutohideStoreEnd2").Select
Selection.EntireRow.Hidden = False
'Hide Blank lines (****** hides entire rows one by one until getting to ending Named Range)
Range("Autohidestorestart2").Select
Do Until ActiveCell.Address = Range("AutoHideStoreEnd2").Address
ActiveCell.Offset(1, 0).Select
If ActiveCell = "" Then
ActiveCell.Rows.Select
Selection.EntireRow.Hidden = True
End If
Loop
'Unhide Areas (****** unhides entire rows (area managers table) )
Range("AutohideStoreStart3", "AutohideStoreEnd3").Select
Selection.EntireRow.Hidden = False
'Hide Blank lines - Areas (******hides entire rows one by one until getting to ending Named Range)
Range("Autohidestorestart3").Select
Do Until ActiveCell.Address = Range("AutoHideStoreEnd3").Address
'ActiveCell.Offset(1, 0).Select
If ActiveCell = "" Then
ActiveCell.Rows.Select
Selection.EntireRow.Hidden = True
End If
ActiveCell.Offset(1, 0).Select
Loop
'Update Selections to All (*******SelectCluster (the named range for Area) changed to ALL)
Application.Range("SelectCluster") = KeyWord
'Unhide rows
Application.GoTo ("Autohidestorestart")
Application.Range("AutohideStoreStart", "AutohideStoreEnd").Select
Selection.EntireRow.Hidden = False
'Find end of report
Application.Range("Autohidestorestart").Select
Do Until ActiveCell = ""
ActiveCell.Offset(1, 0).Select
Loop
'Hide Rows
Application.Range(ActiveCell, Selection.End(xlDown)).Select
Selection.EntireRow.Hidden = True
'returning to change cell
Application.Range("SelectTerritory").Select
End If
'If Cluster is selected
If Not Application.Intersect(KeyCells3, Range(target.Address)) _
Is Nothing Then
'Freeze Screen
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Update Selections to All
'Range("SelectStore") = KeyWord
'Unhide Top 5 Rows
Range("AutohideStoreStart2", "AutohideStoreEnd2").Select
Selection.EntireRow.Hidden = False
'Hide Blank lines - Top 5 stores
Range("Autohidestorestart2").Select
Do Until ActiveCell.Address = Range("AutoHideStoreEnd2").Address
ActiveCell.Offset(1, 0).Select
If ActiveCell = "" Then
ActiveCell.Rows.Select
Selection.EntireRow.Hidden = True
End If
Loop
'Unhide Areas
Range("AutohideStoreStart3", "AutohideStoreEnd3").Select
Selection.EntireRow.Hidden = False
'Hide Blank lines - Areas
Range("Autohidestorestart3").Select
Do Until ActiveCell.Address = Range("AutoHideStoreEnd3").Address
'ActiveCell.Offset(1, 0).Select
If ActiveCell = "" Then
ActiveCell.Rows.Select
Selection.EntireRow.Hidden = True
End If
ActiveCell.Offset(1, 0).Select
Loop
'Unhide rows
Range("AutohideStoreStart", "AutohideStoreEnd").Select
Selection.EntireRow.Hidden = False
'Find end of report
Range("Autohidestorestart").Select
Do Until ActiveCell = ""
ActiveCell.Offset(1, 0).Select
Loop
'Hide Rows
Range(ActiveCell, Selection.End(xlDown)).Select
Selection.EntireRow.Hidden = True
'returning to change cell
Range("SelectCluster").Select
End If
'Unfreeze Screens
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End SubCan anyone suggest a better way to write this event or any part of it without changing the ultimate effect of displaying the results for the selections made?
as an addendum, I have created another macro which uses this event change to run each of the Territories reports (it loops through a list and changes the value of the Territory dropdown then copies/pastes the results to a seperate workbook, territory by territory)
The combination of the two is really slow.
Rich (BB code):
Sub StoreReports()
'\\\macro to create a weekly view of each of the territories based on Report-Dashboard-Group
Dim MSRCopyRange As Range
Dim dvCell As Range
Dim inputRange As Range
Dim c As Variant
Dim cname As String
Dim Sourcewb As Workbook, newbiewb As Workbook
Dim varWeek As String
Dim varRetailyear As String
Dim fname As String
Dim wklyupdatefolder As String
Dim WklyMSRFinal As String
Dim WklyMSRTemp As String
Dim WklyMSRTempFileExt As String
Dim mystring As String
Call refresh_applicationSettings ' ensures global settings are on
With Application
.DisplayAlerts = False
.EnableEvents = True 'events must be turned on so that sheet change event fires when territory selection changes
.ScreenUpdating = False
End With
'password protect running of weekly store results
mystring = Application.InputBox("Please enter password", "This Report is Password Protected")
If mystring <> "lornajane" Then
MsgBox "Incorrect Password"
Exit Sub
Else
End If
Set Sourcewb = ActiveWorkbook
'Load Variables
varWeek = Range("varretailweek") ' week of the current year
varRetailyear = Range("varretailyear") ' retail year
WklyMSRTempFileExt = Range("VarMasterStoreReportTemplateFileExtension") ' file extension .xltm, .xlsm, etc
fname = Range("VarMasterStoreReport") ' file name itself
wklyupdatefolder = Range("VarMasterStoreReportPath") ' path to the report
WklyMSRFinal = wklyupdatefolder & fname & " - " & varWeek & WklyMSRTempFileExt ' final output file name - incl week nbr
WklyMSRTemp = wklyupdatefolder & fname & WklyMSRTempFileExt ' name of file to use ase report template
'using data val as list containing each teritory
'Which cell has data validation
Set dvCell = Application.Range("SelectTerritory") 'Worksheets("Report-Dashboard-Group").Range("b5")
'Determine where validation comes from
Set inputRange = Evaluate(dvCell.Validation.Formula1)
'open report template
Set newbiewb = Workbooks.Open(WklyMSRTemp) '"D:\Incentive Program\AJM\Lorna Jane - Store Results.xlsm")
'return focus to ThisWorkbook
Sourcewb.Activate
'Begin our loop
With Sourcewb
.ActiveSheet.Range("$J$341:$am$362").UnMerge
For Each c In inputRange 'each territory in the list
If c.Value = "" Then GoTo EndMSReport ' when you get to the bottom of the list
dvCell = c.Value ' apply the list value to the data val dropdown
cname = c.Value ' use a sheet name variable to also hold the territory name
Range("MasterStoreReportRange").Copy ' grab the entire range
'without passing foucus to the newly opened report file, paste clipboard contents into corresponding tab at A3
With newbiewb.Sheets(cname).Columns("A")
If .EntireColumn.Hidden Then
.EntireColumn.ShowDetail = True 'ungroups grouped columns
End If
End With
With newbiewb
.Sheets(cname).Range("A3").PasteSpecial xlPasteValues
.Sheets(cname).Range("A3").PasteSpecial xlPasteFormats
.Sheets(cname).Columns("A").ShowDetail = False 'regroups grouped columns
For i = 341 To 364
With newbiewb.Sheets(cname).Range("$j$" & i & ":$am$" & i)
.Merge 'remerge commentary cells
.WrapText = True
End With
Next i
' make row height large enough to contain and wrap all store/area numbers
.Sheets(cname).Range("$j$341:$am$364").RowHeight = 141
End With
'dump clipboard contents
Application.CutCopyMode = False
Next c
EndMSReport: ' resume macro process after looping through validation list
With newbiewb
.Sheets("Report").Activate 'return to first sheet in workbook
End With
'*****************************************************'
'TEST FOR EXISTENCE OF CURRENT WEEK BEFORE OVERWRITING'
'*****************************************************'
ActiveWorkbook.SaveCopyAs Filename:=WklyMSRFinal ' save store reports as "Store Reports - week #"
'Close Store Reports template - changes not saved
ActiveWindow.Close
'open "Store Reports - Week #"
'Workbooks.Open (WklyMSRFinal)
'return focus to ThisWorkbook
Sourcewb.Activate
Call ClearSelectionStore 'returns Report-Dashboard-Group to All
End With
With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
