6
\$\begingroup\$

I have created an automated macro which takes vehicle crash data from a .csv file and automatically creates a pivot table and charts and compares it to the previous year. The code is approximately 1400 lines long and the data of the uploaded .csv can be anywhere between 2 to 100 MB .csv files with more than 100,000 rows and 36 columns.

The macro runs fine but it makes the machine very very slow and even causes it to crash most of the times. If I tab, to respond to an email, it has a high probability of crashing. Either the macro is continuing to try to do something after running successfully or it is keeping memory tied up after it has finished.

I need a way to optimize this. I have attached the entire macro.

Dim YEAR_COL, TYPE_COL As String
Dim CITY_COL, COUNTY_COL As String
Dim DOCNUM_COL, MONTH_COL As String
Dim COUNTY_CITY_COL, CRASH_DATE_COL As String
Dim INJ_TYPE_SERIOUS, INJ_TYPE_FATAL As Integer
Dim G_HEIGHT, G_WIDTH As Integer
Dim G_TOP, G_LEFT As Integer
Dim myColor1(12), myColor2(14) As Long

Dim CURR_YEAR As Integer, PREV_YEAR As Integer
Dim YEAR_NOT_FOUND_MSG As String
Dim INJ_TYPE_NOT_FOUND_MSG As String
Dim CATEGORY_TEXT As String

Dim UPLOADED_DATA_SHEET_NAME As String
Dim CURR_YEAR_SHEET_NAME As String
Dim PREV_YEAR_SHEET_NAME As String
Dim FILTERED_DATA_SHEET_NAME As String, DATA_SHEET_NAME As String
Dim SER_FAT_PLOT_SHEET As String
Dim SER_INJ_DATA_SHEET As String, FAT_INJ_DATA_SHEET As String
Dim SER_INJ_PIVOT_SHEET As String, FAT_INJ_PIVOT_SHEET As String
Dim CHART_SHEET As String

Dim CATEGORY_COL_NAME As String, CATEGORY_COL_NAME2 As String
Dim TOTAL_CATEGORIES As Integer, CATEGORY_TYPE As Integer
Dim SER_UNRESTRAINED_COL_NAME As String, FAT_UNRESTRAINED_COL_NAME As String
Dim ALCOHOL_COL_NAME As String, SPEED_COL_NAME As String
Dim TEEN_DRIVER_COL_NAME As String, OLD_DRIVER_COL_NAME As String
Dim DISTRACTION_COL_NAME As String, MOTORCYCLE_COL_NAME As String
Dim CMV_COL_NAME As String, BICYCLE_COL_NAME As String
Dim PEDESTRIAN_COL_NAME As String, LRG_TRUCK_COL_NAME As String

Dim CHART1_TITLE As String, CHART2_TITLE As String
Dim CHART3_TITLE As String, CHART4_TITLE As String
Dim INCREMENT_ROWS As Integer
Dim USE_EXISTING_DATA As Boolean


Private Sub InitializeVars()
TYPE_COL = "MinInjuryTypeID"
YEAR_COL = "Year"
CITY_COL = "City_Name"
COUNTY_COL = "County_Name"
COUNTY_CITY_COL = "County_City"
DOCNUM_COL = "DocumentNumber"
MONTH_COL = "MonthName"
CRASH_DATE_COL = "CrashDate"

INJ_TYPE_SERIOUS = 2
INJ_TYPE_FATAL = 1
CURR_YEAR = year(Now())
PREV_YEAR = CURR_YEAR - 1
TOTAL_YEARS = 5
CURR_YEAR_SHEET_NAME = "" & CURR_YEAR
PREV_YEAR_SHEET_NAME = "" & PREV_YEAR
INCREMENT_ROWS = 7500

' Speed, Alcohol, Unbelted, teen, old, texting, distraction
CATEGORY_TYPE = 0
CATEGORY_COL_NAME = ""
CATEGORY_COL_NAME2 = ""

FAT_UNRESTRAINED_COL_NAME = "unrestrainedFatals"
SER_UNRESTRAINED_COL_NAME = "UnrestrainedInjuries"
SPEED_COL_NAME = "Speed"
ALCOHOL_COL_NAME = "Alcohol"
CMV_COL_NAME = "CMV"
BICYCLE_COL_NAME = "Bicycle"
PEDESTRIAN_COL_NAME = "Pedestrian"
MOTORCYCLE_COL_NAME = "Motorcycle"
TEEN_DRIVER_COL_NAME = "TeenDriverInvolved"
OLD_DRIVER_COL_NAME = "OlderDriverInv"
LRG_TRUCK_COL_NAME = "LrgTruck"
DISTRACTION_COL_NAME = "DistractionInvolved"

YEAR_NOT_FOUND_MSG = "Please enter column name for filtering injury records by Year."
INJ_TYPE_NOT_FOUND_MSG = "Please enter column name for filtering by Injury Type."

G_TOP = 20
G_LEFT = 20
G_WIDTH = 2000
G_HEIGHT = 530

UPLOADED_DATA_SHEET_NAME = "Uploaded Data"
FILTERED_DATA_SHEET_NAME = "Filtered Data"
DATA_SHEET_NAME = "Data"
SER_INJ_DATA_SHEET = "Data(Ser_Injuries)"
FAT_INJ_DATA_SHEET = "Data(Fatalities)"
SER_INJ_PIVOT_SHEET = "Serious Injuries by County_City"
FAT_INJ_PIVOT_SHEET = "Fatalities by County_City"
SER_FAT_PLOT_SHEET = "Ser_Inj_Fatalities_Plot_Data"
CHART_SHEET = "Plots"

' color codes for difference chart
myColor1(1) = RGB(209, 190, 184)
myColor1(2) = RGB(196, 161, 149)
myColor1(3) = RGB(186, 133, 115)
myColor1(4) = RGB(191, 112, 86)
myColor1(5) = RGB(179, 85, 54)
myColor1(6) = RGB(163, 107, 88)
myColor1(7) = RGB(158, 93, 46)
myColor1(8) = RGB(191, 76, 38)
myColor1(9) = RGB(184, 56, 13)
myColor1(10) = RGB(145, 74, 23)
myColor1(11) = RGB(140, 42, 10)
myColor1(12) = RGB(115, 45, 22)

' color codes for total and difference chart
myColor2(1) = RGB(209, 190, 184)
myColor2(2) = RGB(196, 161, 149)
myColor2(3) = RGB(186, 133, 115)
myColor2(4) = RGB(191, 112, 86)
myColor2(5) = RGB(179, 85, 54)
myColor2(6) = RGB(163, 107, 88)
myColor2(7) = RGB(158, 93, 46)
myColor2(8) = RGB(191, 76, 38)
myColor2(9) = RGB(184, 56, 13)
myColor2(10) = RGB(145, 74, 23)
myColor2(11) = RGB(140, 42, 10)
myColor2(12) = RGB(115, 45, 22)
myColor2(13) = RGB(7, 162, 240)
myColor2(14) = RGB(255, 0, 0)

End Sub


Sub RunFullMacro()
Dim strFile As String

With Application
    .Calculation = xlManual
    .ScreenUpdating = False
    .EnableEvents = False
End With

Call InitializeVars
'Call GetYearFromUser
strFile = GetYearForComparison()
Call GetFilterCategory

If USE_EXISTING_DATA = False Then
    Call ImportCurrentYearCSV(strFile)
    Call MoveDataToProperSheets(CURR_YEAR, CURR_YEAR_SHEET_NAME)
    Call MoveDataToProperSheets(PREV_YEAR, PREV_YEAR_SHEET_NAME)
End If

CHART1_TITLE = "Difference in serious injuries" & CATEGORY_TEXT & " (" & PREV_YEAR & " - " & CURR_YEAR & ")"
CHART2_TITLE = "Difference in fatal injuries" & CATEGORY_TEXT & " (" & PREV_YEAR & " - " & CURR_YEAR & ")"
CHART3_TITLE = "Total number of crashes" & CATEGORY_TEXT & " with difference in number of serious injuries by month between " & _
                                PREV_YEAR & " and " & CURR_YEAR
CHART4_TITLE = "Total number of crashes" & CATEGORY_TEXT & " with difference in number of fatal injuries by month between " & _
                                PREV_YEAR & " and " & CURR_YEAR

Call CreateInitialDataSheets
Call ConcatenateColumns
Call CreateFilteredDataSheets
Call CreatePivotTables
Call CreatePlots

With Application
    .Calculation = xlAutomatic
    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub


Private Sub GetYearFromUser()
Dim userYear As String
Dim msg As String
msg = ""

EnterYear:
userYear = InputBox(Prompt:=msg & "Enter Year for comparing data:", title:="Year for comparing data")

' If no data entered, exit application
If userYear = "" Or userYear = vbNullString Then
    MsgBox "Invalid Year." & vbNewLine & "Exiting."
    End
ElseIf IsNumeric(userYear) = True Then
    If CInt(userYear) > year(Now()) Then
            msg = "Invalid Year. "
            GoTo EnterYear
    Else
        CURR_YEAR = userYear
        PREV_YEAR = CInt(userYear) - 1
    End If
Else
    msg = "Invalid Year. "
    GoTo EnterYear
End If

' reinitialize variables
CURR_YEAR_SHEET_NAME = "" & CURR_YEAR
PREV_YEAR_SHEET_NAME = "" & PREV_YEAR
End Sub


Private Function GetYearForComparison()
Dim strFile As String
Dim answer As Integer
strFile = ""

If SheetExists(PREV_YEAR_SHEET_NAME) = False Or SheetExists(CURR_YEAR_SHEET_NAME) = False Then
    USE_EXISTING_DATA = False
Else
    USE_EXISTING_DATA = True
End If

If USE_EXISTING_DATA = True Then
    answer = MsgBox("Do you want to use the existing data for comparison?", vbYesNo, "Use existing data")
    If answer = vbYes Or answer = 6 Then
        USE_EXISTING_DATA = True
    Else
        USE_EXISTING_DATA = False
    End If
End If

' import sheet for current selected year
If USE_EXISTING_DATA = False Then
   ' strFile = "Macintosh HD:Users:sneha.banerjee:Sites:XLS:2016.csv"
   ' MsgBox "Uploading Data"
     strFile = Application.GetOpenFilename("Csv Files (*.csv), *.csv", , "Please select a CSV file")

    If strFile = "" Or strFile = vbNullString Then
        'USE_EXISTING_DATA = True
        MsgBox "Exiting..."
        End
    End If
End If

GetYearForComparison = strFile
End Function


Private Function SheetExists(ByVal name As String) As Boolean
On Error GoTo ReturnFalse
Sheets(name).Activate

' Sheet exists
SheetExists = True
Exit Function

ReturnFalse:
SheetExists = False
End Function


Private Sub ImportCurrentYearCSV(ByVal strFile As String)
Dim dataSheet As Worksheet

' assume previous years sheet already stored, store entered sheet as current year sheet
Call Get_Sheet(UPLOADED_DATA_SHEET_NAME, True)
Sheets(UPLOADED_DATA_SHEET_NAME).Activate
Set dataSheet = ActiveSheet

With dataSheet.QueryTables.Add(Connection:= _
    "TEXT;" & strFile, Destination:=Range("A1"))
    .name = "Uploaded Data"
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .SaveData = True
    .AdjustColumnWidth = True
    .TextFilePromptOnRefresh = False
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = True
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = False
    .Refresh BackgroundQuery:=False
    End With
    Application.CutCopyMode = False

'Move current year sheet after previous year
'currYearSheet.Move after:=Sheets(UPLOADED_DATA_SHEET_NAME)

'Move initial data sheet after current year
'Call Get_Sheet(DATA_SHEET_NAME, True)
'Sheets(DATA_SHEET_NAME).Move after:=Sheets(CURR_YEAR_SHEET_NAME)
 End Sub


 Private Sub MoveDataToProperSheets(ByVal CurrYear As Integer, ByVal sheetName As String)
Dim colNo As Integer
Dim rng1 As Range

Sheets(UPLOADED_DATA_SHEET_NAME).Activate
colNo = Search_ColumnWithTitle(YEAR_COL, "Please enter column name for Year")

With ActiveSheet
        .AutoFilterMode = False
        .Range(Cells(1, 1), Cells(1, Columns.count)).AutoFilter
        .Range(Cells(1, 1), Cells(1, Columns.count)).AutoFilter Field:=colNo, Criteria1:="" & CurrYear, Operator:=xlFilterValues
End With

Set rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeVisible)
If rng1.Rows.count <= 1 Then
    ' Do nothing
Else
    Call Get_Sheet(sheetName, True)
    ' Copy curr year's data to proper data sheet
    Call CopyInPartsSpecial(UPLOADED_DATA_SHEET_NAME, rng1, sheetName)
End If

If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
    ActiveSheet.ShowAllData
    ActiveSheet.AutoFilterMode = False
End If
 End Sub


 Private Function Select_File_Mac() As String
Dim MyScript As String
Dim MyFile As String

'#If Mac Then
'    strFile = Select_File_Mac()
'#Else
'    strFile = Application.GetOpenFilename("Csv Files (*.csv), *.csv", , "Please select a CSV file")
'#End If¼

On Error Resume Next

' In the following statement, change true to false in the line "multiple
' selections allowed true" if you do not want to be able to select more
' than one file. Additionally, if you want to filter for multiple files, change
' {""com.microsoft.Excel.xls""} to
' {""com.microsoft.excel.xls"",""public.comma-separated-values-text""}
' if you want to filter on xls and csv files, for example.
MyScript = _
        "set applescript's text item delimiters to "","" " & vbNewLine & _
        "set the Files to (choose file of type " & _
         " {""public.comma-separated-values-text""} " & _
           "with prompt ""Please select a file"" default location alias """ & _
           """ multiple selections allowed false) as string" & vbNewLine & _
           "set applescript's text item delimiters to """" " & vbNewLine & _
           "return the Files"

MyFile = MacScript(MyScript)
On Error GoTo 0

If MyFile <> "" Then
    Select_File_Or_Files_Mac = MyFile
Else
    Select_File_Or_Files_Mac = ""
End If
End Function


 Private Sub CreateInitialDataSheets()
Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range, destCell As Range

' validate data for curr and prev years exist
If SheetExists(PREV_YEAR_SHEET_NAME) = False Then
        MsgBox "Data for " & PREV_YEAR & " not found. Upload data and try again. " & vbNewLine & "Exiting."
        End
ElseIf SheetExists(CURR_YEAR_SHEET_NAME) = False Then
        MsgBox "Data for " & CURR_YEAR & " not found. Upload data and try again. " & vbNewLine & "Exiting."
        End
End If

' Get latest date of current year data
Call Get_Sheet(DATA_SHEET_NAME, True)
Sheets(CURR_YEAR_SHEET_NAME).Activate

colNo = Search_ColumnWithTitle(CRASH_DATE_COL, "Please enter column name for Crash Date")
col2 = Search_ColumnWithTitle(TYPE_COL, "Please enter column name for Injury type")
lastRow = Get_LastRowNo(1)
lastCol = Get_LastColumnNo()

Set rng = ActiveSheet.Range(ActiveSheet.Cells(2, colNo), ActiveSheet.Cells(lastRow, colNo))
maxDate = Application.WorksheetFunction.Max(rng) - 365

' Get data less than equal to max date of previous year
Sheets(PREV_YEAR_SHEET_NAME).Activate
colNo = Search_ColumnWithTitle(CRASH_DATE_COL, "Please enter column name for Crash Date")

With ActiveSheet
        .AutoFilterMode = False
        .Range(Cells(1, 1), Cells(1, Columns.count)).AutoFilter
        .Range(Cells(1, 1), Cells(1, Columns.count)).AutoFilter Field:=colNo, Criteria1:="<=" & maxDate, Operator:=xlFilterValues
End With

' Copy previous year's data to data sheet
'ActiveSheet.Cells.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets(DATA_SHEET_NAME).Range("A1")
Call CopyInPartsSpecial(PREV_YEAR_SHEET_NAME, ActiveSheet.Cells.SpecialCells(xlCellTypeVisible), DATA_SHEET_NAME)

On Error GoTo Proceed
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
    ActiveSheet.ShowAllData
    ActiveSheet.AutoFilterMode = False
End If

Proceed:
'Copy all current year to data sheet
Sheets(CURR_YEAR_SHEET_NAME).Activate
Set ws = ActiveSheet
Set rng2 = ws.Range(ws.Cells(2, 1), ws.Cells(lastRow, lastCol))
'Set destCell = Sheets(DATA_SHEET_NAME).Cells(Rows.Count, "A").End(xlUp).Offset(1)
'rng2.Copy Destination:=destCell
Call CopyInPartsSpecial(CURR_YEAR_SHEET_NAME, rng2, DATA_SHEET_NAME)

On Error GoTo Proceed1
Sheets(DATA_SHEET_NAME).Activate
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
    ActiveSheet.ShowAllData
    ActiveSheet.AutoFilterMode = False
End If
Columns.AutoFit
Proceed1:

 End Sub


 Private Sub CreateFilteredDataSheets()
Dim colNo As Integer

If CATEGORY_TYPE = 0 Then
    Application.DisplayAlerts = False
    Call Get_Sheet(FILTERED_DATA_SHEET_NAME, True)
    Sheets(FILTERED_DATA_SHEET_NAME).Delete
    FILTERED_DATA_SHEET_NAME = DATA_SHEET_NAME
    Application.DisplayAlerts = True
    GoTo Exitsub
End If

' copy filtered data to new sheet
Call Get_Sheet(FILTERED_DATA_SHEET_NAME, True)
Sheets(DATA_SHEET_NAME).Activate
colNo = Search_ColumnWithTitle(CATEGORY_COL_NAME, "Please enter column name for Accident category")

If CATEGORY_TYPE = 3 Then
    colNo = GetCategoryColumn()
    With ActiveSheet
        .AutoFilterMode = False
        .Range(Cells(1, 1), Cells(1, Columns.count)).AutoFilter
        .Range(Cells(1, 1), Cells(1, Columns.count)).AutoFilter Field:=colNo, Criteria1:=">=1", Operator:=xlFilterValues
    End With
Else
    With ActiveSheet
        .AutoFilterMode = False
        .Range(Cells(1, 1), Cells(1, Columns.count)).AutoFilter
        .Range(Cells(1, 1), Cells(1, Columns.count)).AutoFilter Field:=colNo, Criteria1:=Array("Y", "YES"), Operator:=xlFilterValues
    End With
End If

' Copy filtered data to new sheet
Call CopyInPartsSpecial(DATA_SHEET_NAME, ActiveSheet.Cells.SpecialCells(xlCellTypeVisible), FILTERED_DATA_SHEET_NAME)

On Error GoTo Proceed
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
    ActiveSheet.ShowAllData
    ActiveSheet.AutoFilterMode = False
End If

Proceed:
' Delete temporary column
If CATEGORY_TYPE = 3 Then
    Sheets(DATA_SHEET_NAME).Columns(colNo).ClearContents
End If
Exitsub:
Sheets(FILTERED_DATA_SHEET_NAME).Activate
Columns.AutoFit

 End Sub


 Private Sub ConcatenateColumns()
Dim col1 As Integer, col2 As Integer
Dim rowCount As Long, resultCol As Integer

Sheets(DATA_SHEET_NAME).Activate
col1 = Search_ColumnWithTitle(COUNTY_COL, "Please enter column name for County")
col2 = Search_ColumnWithTitle(CITY_COL, "Please enter column name for City")

rowCount = Get_LastRowNo(1)

'  Find first available column for results
If IsError(Application.Match(COUNTY_CITY_COL, Range(Cells(1, 1), Cells(1, Columns.count)), 0)) Then
    ' column not present, find first empty column
    resultCol = Get_LastColumnNo() + 1
Else
    ' column already present, clear it
    resultCol = Application.Match(COUNTY_CITY_COL, Range(Cells(1, 1), Cells(1, Columns.count)), 0)
    Columns(resultCol).ClearContents
End If

' Populate Final results
Cells(1, resultCol).value = COUNTY_CITY_COL
For rowNo = 2 To rowCount
    Cells(rowNo, resultCol).value = Trim(Cells(rowNo, col1).value & Cells(rowNo, col2).value)
Next
Columns(resultCol).Select
Selection.EntireColumn.AutoFit

Application.CutCopyMode = False
End Sub


Private Function GetCategoryColumn()
Dim col1 As Integer, col2 As Integer
Dim rowCount As Long, resultCol As Integer

Sheets(DATA_SHEET_NAME).Activate
col1 = Search_ColumnWithTitle(CATEGORY_COL_NAME, "Please enter column name for Unbelted Fatalities")
col2 = Search_ColumnWithTitle(CATEGORY_COL_NAME2, "Please enter column name for Unbelted Serious Injuries")

rowCount = Get_LastRowNo(1)
resultCol = Get_LastColumnNo() + 1

' Populate Final values
Cells(1, resultCol).value = "TEMP_COL"
For rowNo = 2 To rowCount
    If IsTrue(Cells(rowNo, col1).value) Or IsTrue(Cells(rowNo, col2).value) Then
        Cells(rowNo, resultCol).value = 1
    Else
        Cells(rowNo, resultCol).value = 0
    End If
Next
Columns(resultCol).Select
Selection.EntireColumn.AutoFit

Application.CutCopyMode = False
GetCategoryColumn = resultCol
End Function


Private Function IsTrue(ByVal value As String) As Boolean
Dim returnValue As Integer
If IsNumeric(value) Then
    If CInt(value) > 0 Then
        returnValue = 1
    Else
        returnValue = 0
    End If
ElseIf value = "YES" Or value = "Y" Then
    returnValue = 1
Else
    returnValue = 0
End If
IsTrue = returnValue
End Function


 Private Sub CreatePivotTables()
Dim colNo As Integer

Sheets(FILTERED_DATA_SHEET_NAME).Activate
colNo = Search_ColumnWithTitle(TYPE_COL, INJ_TYPE_NOT_FOUND_MSG)

Call CreateDataSheet(INJ_TYPE_SERIOUS, colNo, SER_INJ_DATA_SHEET)
Call CreateDataSheet(INJ_TYPE_FATAL, colNo, FAT_INJ_DATA_SHEET)

On Error GoTo Proceed
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
    ActiveSheet.ShowAllData
    ActiveSheet.AutoFilterMode = False
End If

Proceed:
Sheets(SER_INJ_DATA_SHEET).Activate
Call CreatePivotTable(SER_INJ_PIVOT_SHEET)

Sheets(FAT_INJ_DATA_SHEET).Activate
Call CreatePivotTable(FAT_INJ_PIVOT_SHEET)

End Sub


Private Sub CreateDataSheet(ByVal val As Integer, ByVal colNo As Integer, ByVal sheetName As String)
With ActiveSheet
        .AutoFilterMode = False
        .Range(Cells(1, 1), Cells(1, Columns.count)).AutoFilter
        .Range(Cells(1, 1), Cells(1, Columns.count)).AutoFilter Field:=colNo, Criteria1:=val
End With

' verify sheet is present and clear it, else create new
Call Get_Sheet(sheetName, True)

' copy data sheet to new sheet
Sheets(FILTERED_DATA_SHEET_NAME).Activate
'ActiveSheet.Cells.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets(sheetName).Range("A1")
Call CopyInPartsSpecial(FILTERED_DATA_SHEET_NAME, ActiveSheet.Cells.SpecialCells(xlCellTypeVisible), sheetName)

On Error GoTo Proceed
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
    ActiveSheet.ShowAllData
    ActiveSheet.AutoFilterMode = False
End If

Proceed:
Sheets(sheetName).Activate
Columns.AutoFit
Sheets(FILTERED_DATA_SHEET_NAME).Activate

End Sub


Private Sub CreatePivotTable(ByVal pvtShtName As String)
Dim pivotSheet As Worksheet
Dim dataSheet As String

dataSheet = ActiveSheet.name

' Create Pivot Sheet
Call Get_Sheet(pvtShtName, True)
Set pivotSheet = Sheets(pvtShtName)

' select data source for pivot table
Sheets(dataSheet).Activate
resultCol = Application.Match(COUNTY_CITY_COL, Range(Cells(1, 1), Cells(1, Columns.count)), 0)
rowCount = Get_LastRowNo(1)
srcData = ActiveSheet.name & "!" & Range(Cells(1, 1), Cells(rowCount, resultCol)).Address(ReferenceStyle:=xlR1C1)

' Create Pivot Cache from Source Data
Set pvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=srcData)
pivotSheet.Activate
Set pvt = pvtCache.CreatePivotTable(TableDestination:=Range("A1"), TableName:="PT_" & pvtShtName)

' Specify row and column fields
With pvt.PivotFields(YEAR_COL)
    .Orientation = xlColumnField
    .PivotFilters.Add Type:=xlCaptionIsGreaterThanOrEqualTo, Value1:=PREV_YEAR
End With

pvt.PivotFields(MONTH_COL).Orientation = xlColumnField

With pvt.PivotFields(COUNTY_CITY_COL)
    .Orientation = xlRowField
    .AutoSort xlAscending, COUNTY_CITY_COL
End With

With pvt.PivotFields(DOCNUM_COL)
    .Orientation = xlDataField
    .Function = xlCount
   End With

   Application.CutCopyMode = False
End Sub


Private Function Get_LastRowNo(ByVal colNo As Integer) As Long
Get_LastRowNo = Cells(Rows.count, colNo).End(xlUp).Row
End Function


Private Function Get_LastColumnNo() As Integer
Get_LastColumnNo = Cells(1, Columns.count).End(xlToLeft).Column
End Function


Private Function Get_Sheet(ByVal sheetName As String, ByVal clearSheet As Boolean) As Boolean
Dim ws As Worksheet
Dim dataSheet As String
Dim chtObj As ChartObject

' Check if sheet present, if not create new
dataSheet = ActiveSheet.name

On Error GoTo CreateSheet
    Set ws = Sheets(sheetName)
    If clearSheet = True Then
        ws.Cells.Clear
    End If
    ' Delete all existing charts
    For Each chtObj In ws.ChartObjects
        chtObj.Delete
    Next
    Sheets(dataSheet).Activate
    Get_Sheet = False
Exit Function

CreateSheet:
' If current sheet empty, rename it and use it
If ActiveSheet.UsedRange.Rows.count = 1 _
    And ActiveSheet.UsedRange.Columns.count = 1 And Cells(1, 1).value = "" Then
    ActiveSheet.name = sheetName
Else
    Sheets.Add(, ActiveSheet).name = sheetName
    Sheets(dataSheet).Activate
End If
Get_Sheet = True

End Function


' Assuming ActiveSheet and title on Row 1
Private Function Search_ColumnWithTitle(ByVal title As String, ByVal msg As String) As Integer
CheckColumn:
If IsError(Application.Match(title, Range(Cells(1, 1), Cells(1, Columns.count)), 0)) Then
    title = InputBox(Prompt:="Column '" & title & "' not found. " & msg, _
                                title:="Enter " & title & " column name")

    If title = "" Or title = vbNullString Then
        MsgBox "No column name entered. Exiting..."
        End
    Else
        GoTo CheckColumn
    End If
End If

Search_ColumnWithTitle = Application.Match(title, Range(Cells(1, 1), Cells(1, Columns.count)), 0)
End Function


Private Sub GetFilterCategory()
    Dim categoryNum As String
    Dim text As String
    TOTAL_CATEGORIES = 11

    text = "0. All categories" & vbNewLine & _
               "1. Alcohol" & vbNewLine & _
               "2. Speed" & vbNewLine & _
               "3. Unrestrained" & vbNewLine & _
               "4. CMV" & vbNewLine & _
               "5. Bicylce" & vbNewLine & _
               "6. Pedestrian" & vbNewLine & _
               "7. Motorcycle" & vbNewLine & _
               "8. Teen driver involved" & vbNewLine & _
               "9. Older driver involved" & vbNewLine & _
               "10. Large Truck" & vbNewLine & _
               "11. Distraction involved" & vbNewLine & _
               "Enter the category number to be filtered"

    categoryNum = InputBox(Prompt:=text, title:="Filter accidents by category")

    If IsNumeric(categoryNum) Then
        If CInt(categoryNum) >= 0 And CInt(categoryNum) <= TOTAL_CATEGORIES Then
            CATEGORY_TYPE = CInt(categoryNum)
        Else
            CATEGORY_TYPE = 0
        End If
    Else
        MsgBox "Invalid Entry. Exiting..."
        End
    End If

Select Case CATEGORY_TYPE
    Case 1
        CATEGORY_COL_NAME = ALCOHOL_COL_NAME
        CATEGORY_TEXT = " - Alcohol -"
    Case 2
        CATEGORY_COL_NAME = SPEED_COL_NAME
        CATEGORY_TEXT = " - Speeding -"
    Case 3
        CATEGORY_COL_NAME = FAT_UNRESTRAINED_COL_NAME
        CATEGORY_COL_NAME2 = SER_UNRESTRAINED_COL_NAME
        CATEGORY_TEXT = "  - Unrestrained -"
    Case 4
        CATEGORY_COL_NAME = CMV_COL_NAME
        CATEGORY_TEXT = " - CMV -"
    Case 5
        CATEGORY_COL_NAME = BICYCLE_COL_NAME
        CATEGORY_TEXT = " - Bicycle -"
    Case 6
        CATEGORY_COL_NAME = PEDESTRIAN_COL_NAME
        CATEGORY_TEXT = " - Pedestrian -"
    Case 7
        CATEGORY_COL_NAME = MOTORCYCLE_COL_NAME
        CATEGORY_TEXT = " - Motorcycle -"
    Case 8
        CATEGORY_COL_NAME = TEEN_DRIVER_COL_NAME
        CATEGORY_TEXT = " - Teen driver -"
    Case 9
        CATEGORY_COL_NAME = OLD_DRIVER_COL_NAME
        CATEGORY_TEXT = " - Older driver -"
    Case 10
        CATEGORY_COL_NAME = LRG_TRUCK_COL_NAME
        CATEGORY_TEXT = " - Large truck -"
    Case 11
        CATEGORY_COL_NAME = DISTRACTION_COL_NAME
        CATEGORY_TEXT = " - Distraction -"
    Case Else
        CATEGORY_COL_NAME = ""
        CATEGORY_TEXT = ""
End Select
End Sub


Private Function ExitIfColumnNotFound(ByVal colName As String)
    If IsError(Application.Match(colName, Range(Cells(1, 1), Cells(1, Columns.count)), 0)) Then
        MsgBox "Column '" & colName & "' not found. Exiting..."
        End
    End If
End Function

Private Function GetNumberOfMonths(ByVal sheetName As String) As Integer
    Dim prev_year_start_col As Integer, curr_year_start_col As Integer
    Dim colNo As Integer, diff As Integer
    Sheets(sheetName).Activate

    monthNo = 1
    prev_year_start_col = 0
    curr_year_start_col = 0

    On Error Resume Next
    curr_year_start_col = Application.Match(CURR_YEAR, Range(Cells(2, 1), Cells(2, Columns.count)), 0)

    On Error Resume Next
    prev_year_start_col = Application.Match(CURR_YEAR, Range(Cells(2, 1), Cells(2, Columns.count)), 0)

    ' get max number of months
    If curr_year_start_col = 0 And prev_year_start_col = 0 Then
        monthNo = 0
        colNo = 0
    ElseIf curr_year_start_col = 0 Then
        colNo = prev_year_start_col
    Else
        colNo = curr_year_start_col
    End If

    If colNo > 0 Then
        While Cells(3, colNo).value <> ""
            monthNo = Month("1-" & Cells(3, colNo).value & "-2000")
            colNo = colNo + 1
        Wend
    End If

    GetNumberOfMonths = monthNo
End Function


Private Function CopyPivotTable(ByVal sheetName As String, ByVal destStartRow As Integer, ByVal numMonths As Integer) As Variant
    ' Return value: [startRow, startCol, endRow, endCol]
    Dim V(0 To 3) As Variant

    Dim rowNo As Integer, colNo As Integer
    Dim recordsCount As Integer, srcLastRow As Integer
    Dim srcStartCol As Integer, destCurrColNo As Integer
    Dim currYearCol As Integer, lastRow As Integer

    Set src = Sheets(sheetName)
    Set dest = Sheets(SER_FAT_PLOT_SHEET)

    Sheets(sheetName).Activate
    srcLastRow = Get_LastRowNo(1)
    recordsCount = srcLastRow - 2  ' excluding 2 rows for headers
    destCurrColNo = 1

    ' Copy Row Labels i.e. first column
    src.Range(src.Cells(3, 1), src.Cells(srcLastRow, 1)).Copy Destination:=dest.Cells(destStartRow + 1, destCurrColNo)
    dest.Columns.AutoFit
    destCurrColNo = destCurrColNo + 1

    ' Copy prev year data
    destStartCol = 2

    ' column 1 is row header
    srcStartCol = -1 ' in case no data for curr year
    On Error Resume Next
    srcStartCol = Application.Match(PREV_YEAR, src.Range(Cells(2, 1), src.Cells(2, Columns.count)), 0)
    monthNo = 1

    ' no data for curr year
    If srcStartCol = -1 Then
        For colNo = 1 To numMonths
            dest.Cells(destStartRow + 1, destCurrColNo).value = MonthName(monthNo)
                For i = (destStartRow + 2) To (destStartRow + recordsCount)
                    dest.Cells(i, destCurrColNo).value = 0
                Next i
            monthNo = monthNo + 1
            destCurrColNo = destCurrColNo + 1
        Next colNo
    Else

        For colNo = srcStartCol To srcStartCol + numMonths - 1
            monName = src.Cells(3, colNo).value

            ' if month column missing, add it
            If IsEmpty(monName) Or Len(monName) = 0 Then
                dest.Cells(destStartRow + 1, destCurrColNo).value = MonthName(monthNo)
                For i = (destStartRow + 2) To (destStartRow + recordsCount)
                    dest.Cells(i, destCurrColNo).value = 0
                Next i
                colNo = colNo - 1
            ElseIf Month("1-" & monName & "-2000") = monthNo Then
                src.Range(src.Cells(2, colNo), src.Cells(srcLastRow, colNo)).Copy Destination:=dest.Cells(destStartRow, destCurrColNo)
            Else
                dest.Cells(destStartRow + 1, destCurrColNo).value = MonthName(monthNo)
                For i = (destStartRow + 2) To (destStartRow + recordsCount)
                    dest.Cells(i, destCurrColNo).value = 0
                Next i
                colNo = colNo - 1
            End If

            monthNo = monthNo + 1
            destCurrColNo = destCurrColNo + 1
            ' exit if all months copied
            If monthNo > numMonths Then
                Exit For
            End If
        Next colNo
    End If

    ' copy formatting
    src.Range(src.Cells(1, 1), src.Cells(1, numMonth + 2)).Copy
    dest.Cells(destStartRow, destCurrColNo).PasteSpecial Paste:=xlPasteFormats

    Application.CutCopyMode = False

    ' Total of the copied rows excluding headers
    dest.Cells(destStartRow + 1, destCurrColNo).value = PREV_YEAR & " Total"
    For rowNo = (destStartRow + 2) To (destStartRow + recordsCount)
        If srcStartCol = -1 Then
            dest.Cells(rowNo, destCurrColNo).value = 0
        Else
            dest.Cells(rowNo, destCurrColNo).value = Application.Sum(dest.Range(dest.Cells(rowNo, destStartCol), _
                                                                    dest.Cells(rowNo, destStartCol + numMonths - 1)))
        End If
    Next rowNo
    ' copy formatting
    dest.Cells(destStartRow + recordsCount, destCurrColNo - 1).Copy
    dest.Cells(destStartRow + recordsCount, destCurrColNo).PasteSpecial Paste:=xlPasteFormats
    destCurrColNo = destCurrColNo + 1

' ----------------------------------------------------------'

    ' Copy curr year data
    srcStartCol = -1 ' in case no data for curr year
On Error Resume Next
    srcStartCol = Application.Match(CURR_YEAR, src.Range(Cells(2, 1), src.Cells(2, Columns.count)), 0)
    destStartCol = destCurrColNo
    monthNo = 1

    ' no data for curr year
    If srcStartCol = -1 Then
        For colNo = 1 To numMonths
            dest.Cells(destStartRow + 1, destCurrColNo).value = MonthName(monthNo)
                For i = (destStartRow + 2) To (destStartRow + recordsCount)
                    dest.Cells(i, destCurrColNo).value = 0
                Next i
            monthNo = monthNo + 1
            destCurrColNo = destCurrColNo + 1
        Next colNo
    Else

        For colNo = srcStartCol To srcStartCol + numMonths - 1
            monName = src.Cells(3, colNo).value

            ' if month column missing, add it
            If IsEmpty(monName) Or Len(monName) = 0 Then
                dest.Cells(destStartRow + 1, destCurrColNo).value = MonthName(monthNo)
                For i = (destStartRow + 2) To (destStartRow + recordsCount)
                    dest.Cells(i, destCurrColNo).value = 0
                Next i
                colNo = colNo - 1
            ElseIf Month("1-" & monName & "-2000") = monthNo Then
                src.Range(src.Cells(2, colNo), src.Cells(srcLastRow, colNo)).Copy Destination:=dest.Cells(destStartRow, destCurrColNo)
            Else
                dest.Cells(destStartRow + 1, destCurrColNo).value = MonthName(monthNo)
                For i = (destStartRow + 2) To (destStartRow + recordsCount)
                    dest.Cells(i, destCurrColNo).value = 0
                Next i
                colNo = colNo - 1
            End If

            monthNo = monthNo + 1
            destCurrColNo = destCurrColNo + 1
            ' exit if all months copied
            If monthNo > numMonths Then
                Exit For
            End If
        Next colNo
    End If


    ' copy formatting
    src.Range(src.Cells(1, 1), src.Cells(1, numMonth + 2)).Copy
    dest.Cells(destStartRow, destCurrColNo).PasteSpecial Paste:=xlPasteFormats

    Application.CutCopyMode = False

     ' Total of the copied rows excluding headers
    dest.Cells(destStartRow + 1, destCurrColNo).value = CURR_YEAR & " Total"
    For rowNo = (destStartRow + 2) To (destStartRow + recordsCount)
        If srcStartCol = -1 Then
            dest.Cells(rowNo, destCurrColNo).value = 0
        Else
            dest.Cells(rowNo, destCurrColNo).value = Application.Sum(dest.Range(dest.Cells(rowNo, destStartCol), _
                                                                    dest.Cells(rowNo, destStartCol + numMonths - 1)))
        End If
    Next rowNo
    ' copy formatting
    dest.Cells(destStartRow + recordsCount, destCurrColNo - 1).Copy
    dest.Cells(destStartRow + recordsCount, destCurrColNo).PasteSpecial Paste:=xlPasteFormats
    destCurrColNo = destCurrColNo + 1


    ' Calculate difference
    Sheets(SER_FAT_PLOT_SHEET).Activate
    destCurrColNo = destCurrColNo + 1
    V(0) = destStartRow + 1
    V(1) = destCurrColNo

    ' Copy Row Labels i.e. first column
    dest.Range(dest.Cells(destStartRow + 2, 1), dest.Cells(destStartRow + recordsCount, 1)).Copy _
            Destination:=dest.Cells(destStartRow + 2, destCurrColNo)
    destCurrColNo = destCurrColNo + 1
    ' Copy column headings
    For colNo = 2 To numMonths + 1
        dest.Range(dest.Cells(destStartRow + 1, 2), dest.Cells(destStartRow + 1, 1 + numMonths)).Copy _
                            Destination:=dest.Cells(destStartRow + 1, destCurrColNo)
    Next colNo
    dest.Columns.AutoFit

    ' subtract prev year from curr year
    currYearCol = numMonths + 3
    lastRow = recordsCount + destStartRow
    For prevYearCol = 2 To numMonths + 1
        For rowNo = destStartRow + 2 To lastRow
            dest.Cells(rowNo, destCurrColNo) = dest.Cells(rowNo, currYearCol) - dest.Cells(rowNo, prevYearCol)
        Next rowNo
        destCurrColNo = destCurrColNo + 1
        currYearCol = currYearCol + 1
    Next prevYearCol
    V(2) = lastRow

    ' copy totals columns
    prevYearTotalCol = 2 + numMonths
    dest.Range(dest.Cells(destStartRow + 1, prevYearTotalCol), dest.Cells(destStartRow + recordsCount, prevYearTotalCol)).Copy _
                Destination:=dest.Cells(destStartRow + 1, destCurrColNo)
    destCurrColNo = destCurrColNo + 1

    currYearTotalCol = prevYearTotalCol + numMonths + 1
    dest.Range(dest.Cells(destStartRow + 1, currYearTotalCol), dest.Cells(destStartRow + recordsCount, currYearTotalCol)).Copy _
                Destination:=dest.Cells(destStartRow + 1, destCurrColNo)

    V(3) = destCurrColNo
    Application.CutCopyMode = False
    CopyPivotTable = V
End Function


Private Sub CreatePlots()
    Dim numMonths As Integer, top As Integer
    Dim ser_data As Variant, fat_data As Variant

    months1 = GetNumberOfMonths(SER_INJ_PIVOT_SHEET)
    months2 = GetNumberOfMonths(FAT_INJ_PIVOT_SHEET)
    If months1 >= months2 Then
        numMonths = months1
    Else
        numMonths = months2
    End If

    ' Copy and calculate sum and difference
    Call Get_Sheet(SER_FAT_PLOT_SHEET, True)
    startRow1 = 1
    ser_data = CopyPivotTable(SER_INJ_PIVOT_SHEET, startRow1, numMonths)
    Call FillGaps(FILTERED_DATA_SHEET_NAME, SER_FAT_PLOT_SHEET, ser_data)
    Sheets(SER_FAT_PLOT_SHEET).Activate
    ser_data(2) = Get_LastRowNo(1)

    Sheets(SER_FAT_PLOT_SHEET).Activate
    startRow2 = Get_LastRowNo(1) + 3
    fat_data = CopyPivotTable(FAT_INJ_PIVOT_SHEET, startRow2, numMonths)
    Call FillGaps(FILTERED_DATA_SHEET_NAME, SER_FAT_PLOT_SHEET, fat_data)
    Sheets(SER_FAT_PLOT_SHEET).Activate
    fat_data(2) = Get_LastRowNo(1)

    ' Plot graphs
    top = G_TOP
    G_WIDTH = startRow2 * 18
    'Call CreateGraph1(ser_data, "Chart1", top, CHART1_TITLE)
    'top = top + G_HEIGHT + 50
    'Call CreateGraph1(fat_data, "Chart2", top, CHART2_TITLE)
    'Call NormalizeRange("Chart1", "Chart2", 1)

    Call Get_Sheet(CHART_SHEET, True)

    'top = top + G_HEIGHT + 50
    Call CreateGraph2(ser_data, "Chart3", top, CHART3_TITLE)
    top = top + G_HEIGHT + 50
    Call CreateGraph2(fat_data, "Chart4", top, CHART4_TITLE)
    Call NormalizeRange("Chart3", "Chart4", 1)

    Call AlignAxes("Chart3")
    Call AlignAxes("Chart4")
    'Call NormalizeRange("Chart3", "Chart4", 2)

    Application.CutCopyMode = False
    ActiveSheet.Range("A1").Select

End Sub


Private Sub CreateGraph1(ByRef var As Variant, ByVal chartName As String, ByVal gTop As Integer, ByVal title As String)
    Dim startRow As Integer, endRow As Integer
    Dim startCol As Integer, endCol As Integer
    Dim srcRange As Range
    Dim chartObj As Chart
    Dim ws As Worksheet

    startRow = var(0)
    startCol = var(1)
    endRow = var(2) - 1
    endCol = var(3) - 2
    Sheets(SER_FAT_PLOT_SHEET).Activate
    Set srcRange = ws.Range(ws.Cells(startRow, startCol), ws.Cells(endRow, endCol))

    Sheets(CHART_SHEET).Activate
    Set ws = ActiveSheet

    With ws.ChartObjects.Add(Left:=G_LEFT, Width:=G_WIDTH, top:=gTop, Height:=G_HEIGHT)
        .name = chartName
        With .Chart
            .SetSourceData Source:=srcRange
            .ChartType = xlColumnClustered
            .ChartStyle = 2
            .HasTitle = True
            .ChartTitle.text = title
            .ChartTitle.Font.Size = 14
            .HasLegend = True
            .Legend.Position = xlBottom
            With .Legend.Border
              .LineStyle = xlContinuous
              .Weight = xlMedium
              .Color = RGB(255, 153, 51)
            End With
        End With
    End With

    Set chartObj = ws.ChartObjects(chartName).Chart
    With chartObj.ChartGroups(1)
        .Overlap = 0
        .GapWidth = 50
    End With

    ' X-axis
    With chartObj.Axes(xlCategory)
        .TickLabels.Orientation = xlTickLabelOrientationUpward
        .TickLabelPosition = xlTickLabelPositionLow
        .HasMajorGridlines = True
        .MajorGridlines.Border.Color = RGB(204, 204, 204)
    End With

    seriesCount = chartObj.SeriesCollection.count
    For i = 1 To seriesCount
        With chartObj.SeriesCollection(i)
            .ChartType = xlColumnClustered
            .AxisGroup = xlPrimary
            .Interior.Color = myColor1(i)
        End With
    Next i

    ' Y-axiz
    With chartObj.Axes(xlValue)
        .HasMajorGridlines = True
        .MajorGridlines.Border.Color = RGB(204, 204, 204)
    End With

End Sub


Private Sub CreateGraph2(ByRef var As Variant, ByVal chartName As String, ByVal gTop As Integer, ByVal title As String)
    Dim startRow As Integer, endRow As Integer
    Dim startCol As Integer, endCol As Integer
    Dim srcRange As Range
    Dim chartObj As Chart
    Dim ws As Worksheet

    startRow = var(0)
    startCol = var(1)
    endRow = var(2) - 1
    endCol = var(3)
    Sheets(SER_FAT_PLOT_SHEET).Activate
    Set srcRange = Range(Cells(startRow, startCol), Cells(endRow, endCol))

    Sheets(CHART_SHEET).Activate
    Set ws = ActiveSheet

    With ws.ChartObjects.Add(Left:=G_LEFT, Width:=G_WIDTH, top:=gTop, Height:=G_HEIGHT)
        .name = chartName
        With .Chart
            .SetSourceData Source:=srcRange
            .ChartType = xlColumnClustered
            .ChartStyle = 2
            .HasTitle = True
            .ChartTitle.text = title
            .ChartTitle.Font.Size = 14
            .HasLegend = True
            .Legend.Position = xlBottom
            With .Legend.Border
              .LineStyle = xlContinuous
              .Weight = xlMedium
              .Color = RGB(255, 153, 51)
            End With
        End With
    End With

    Set chartObj = ws.ChartObjects(chartName).Chart
    With chartObj.ChartGroups(1)
        .Overlap = 0
        .GapWidth = 50
    End With

    ' X-axis
    With chartObj.Axes(xlCategory)
        .TickLabels.Orientation = xlTickLabelOrientationUpward
        .TickLabelPosition = xlTickLabelPositionLow
        .AxisBetweenCategories = False
        .HasMajorGridlines = True
        .MajorGridlines.Border.Color = RGB(204, 204, 204)
    End With

    seriesCount = chartObj.SeriesCollection.count
    For i = 1 To seriesCount - 2
        With chartObj.SeriesCollection(i)
            .ChartType = xlColumnClustered
            .AxisGroup = xlPrimary
            .Interior.Color = myColor2(i)
        End With
    Next i

    chartObj.HasAxis(xlValue, xlSecondary) = True
    For i = seriesCount - 1 To seriesCount
        With chartObj.SeriesCollection(i)
                .ChartType = xlLineMarkers
                .AxisGroup = xlSecondary
                .MarkerSize = 5
                .MarkerStyle = xlMarkerStylePlus
                .Format.Line.DashStyle = msoLineSysDash
                .Format.Line.Weight = 1
                .Interior.Color = myColor2(13)
        End With
    Next i
    chartObj.SeriesCollection(seriesCount).Format.Line.DashStyle = msoLineSysDot
    chartObj.SeriesCollection(seriesCount).Interior.Color = myColor2(14)
    chartObj.SeriesCollection(seriesCount).MarkerStyle = xlMarkerStyleDiamond

    ' Y-axiz
    With chartObj.Axes(xlValue)
        .HasMajorGridlines = True
        .MajorGridlines.Border.Color = RGB(204, 204, 204)
    End With

    ws.ChartObjects(chartName).Visible = True
End Sub


Private Sub AlignAxes(ByVal chartName As String)
      Dim Y1min As Double
      Dim Y1max As Double
      Dim Y2min As Double
      Dim Y2max As Double
      Dim chartObj As Chart
      Dim ws As Worksheet

      Set ws = ActiveSheet
      Set chartObj = ws.ChartObjects(chartName).Chart
      With chartObj
            With .Axes(2, 1)
              Y1min = .MinimumScale
              Y1max = .MaximumScale
              .MinimumScaleIsAuto = False
              .MaximumScaleIsAuto = False
            End With
            With .Axes(2, 2)
              Y2min = .MinimumScale
              Y2max = .MaximumScale
              .MinimumScaleIsAuto = False
              .MaximumScaleIsAuto = False
              .TickLabels.NumberFormat = "0.0#"
            End With

            If Y1max <> 0 Then
              .Axes(2, 2).MinimumScale = Y1min * Y2max / Y1max
            End If
      End With

End Sub


Private Sub NormalizeRange(ByVal chartName1 As String, ByVal chartName2 As String, ByVal axisNo As Integer)
    Dim chart1 As Chart, chart2 As Chart
    Dim Ymin As Double, Ymax As Double
    Dim ws As Worksheet

    Set ws = ActiveSheet
    Set chart1 = ws.ChartObjects(chartName1).Chart
    Set chart2 = ws.ChartObjects(chartName2).Chart

    If chart1.Axes(2, axisNo).MinimumScale < chart2.Axes(2, axisNo).MinimumScale Then
        Ymin = chart1.Axes(2, axisNo).MinimumScale
    Else
        Ymin = chart2.Axes(2, axisNo).MinimumScale
    End If
    If chart1.Axes(2, axisNo).MaximumScale > chart2.Axes(2, axisNo).MaximumScale Then
        Ymax = chart1.Axes(2, axisNo).MaximumScale
    Else
        Ymax = chart2.Axes(2, axisNo).MaximumScale
    End If

    With chart1.Axes(2, axisNo)
        .MinimumScaleIsAuto = False
        .MaximumScaleIsAuto = False
        .MinimumScale = Ymin
        .MaximumScale = Ymax
    End With
    With chart2.Axes(2, axisNo)
        .MinimumScaleIsAuto = False
        .MaximumScaleIsAuto = False
        .MinimumScale = Ymin
        .MaximumScale = Ymax
    End With

End Sub


Private Sub CopyInParts(ByVal srcSheet As String, ByRef srcRange As Range, ByVal destSheet As String, ByRef destRange As Range)
    Dim srcWs As Worksheet
    Dim destWs As Worksheet
    Dim rng As Range
    Dim destStartRow As Long, rowStart As Long, rowEnd As Long

    rowStart = srcRange.Row
    rowEnd = srcRange.Rows.count + rowStart - 1
    colStart = srcRange.Column
    colEnd = srcRange.Columns.count + colStart - 1
    destStartRow = destRange.Row
    increment = INCREMENT_ROWS

    Set srcWs = Sheets(srcSheet)
    Set destWs = Sheets(destSheet)

    While rowStart < rowEnd
        If srcWs.Cells(rowStart, colStart).value = "" Then
            GoTo CopyPart
        End If

        If rowStart + increment > rowEnd Then
            GoTo CopyPart
        End If
        If rowStart + increment = rowEnd Then
            dsr = rowStart + increment
        Else
            dsr = rowStart + increment - 1
        End If
        Set rng = srcWs.Range(srcWs.Cells(rowStart, colStart), srcWs.Cells(dsr, colEnd))

        rng.Copy Destination:=destWs.Range("A" & destStartRow)
        rowStart = rowStart + increment
        destStartRow = destStartRow + increment
        Application.CutCopyMode = False
    Wend

CopyPart:
    If rowStart <= rowEnd And srcWs.Cells(rowStart, colStart).value <> "" Then
        Set rng = srcWs.Range(srcWs.Cells(rowStart, colStart), srcWs.Cells(rowEnd, colEnd))
        rng.Copy Destination:=destWs.Range("A" & destStartRow)
        Application.CutCopyMode = False
    End If

End Sub


Private Sub CopyInPartsSpecial(ByVal srcSheet As String, ByRef srcRange As Range, ByVal destSheet As String)
    Dim destWs As Worksheet
    Dim rng As Range, area As Range

    Set destWs = Sheets(destSheet)
    For Each area In srcRange.Areas
        rowNo = destWs.UsedRange.Rows.count
        If rowNo = 1 And destWs.Cells(1, 1).value = "" Then
            rowNo = 1
        Else
            rowNo = rowNo + 1
        End If
        Set rng = destWs.Range("A" & rowNo)
        Call CopyInParts(srcSheet, area, destSheet, rng)
    Next area
End Sub


Private Sub FillGaps(ByVal src As String, ByVal dest As String, ByRef destVars As Variant)
    ' destvars = [startRow, startCol, endRow, endCol]
    Dim srcSheet As Worksheet
    Dim destSheet As Worksheet
    Dim srcRange As Range
    Dim sortedRange As Range
    Dim destRange As Range

    Set srcSheet = Sheets(src)
    Set destSheet = Sheets(dest)

    srcSheet.Activate
    lastRow = Get_LastRowNo(1)
    colNo = Search_ColumnWithTitle(COUNTY_CITY_COL, "")
    Set srcRange = srcSheet.Range(srcSheet.Cells(2, colNo), srcSheet.Cells(lastRow, colNo))
    Set sortedRange = srcSheet.Range(srcSheet.Cells(2, colNo + 1), srcSheet.Cells(lastRow, colNo + 1))

    srcRange.Copy Destination:=srcSheet.Cells(2, colNo + 1)
    'sortedRange.RemoveDuplicates Columns:=(colNo + 1), Header:=xlNo
    sortedRange.RemoveDuplicates Columns:=1, Header:=xlNo
    sortedRange.Sort Key1:=sortedRange, Order1:=xlAscending

    destSheet.Activate
    destRow = destVars(0) + 1
    Set destRange = destSheet.Range(destSheet.Cells(destRow, 1), destSheet.Cells(destRow, destVars(3)))
    For srcRow = 2 To lastRow
        ccName = srcSheet.Cells(srcRow, colNo + 1).value
        If ccName = "" Then
            Exit For
        End If

        If destSheet.Cells(destRow, 1).text <> ccName Then
            destRange.Insert Shift:=xlDown
            destSheet.Cells(destRow, 1).value = ccName
            destSheet.Cells(destRow, destVars(1)).value = ccName
            For i = destVars(1) + 1 To destVars(3)
                destSheet.Cells(destRow, i).value = "0"
            Next i
        Else
            Set destRange = destRange.Offset(1, 0)
        End If
        destRow = destRange.Row
    Next srcRow

    sortedRange.ClearContents
End Sub
\$\endgroup\$
  • \$\begingroup\$ Honestly I'm having a tough time diving into your code thoroughly, perhaps you could break it up into multiple questions if you'd like a more in-depth review. I'm not saying you're breaking any rules - meta.codereview.stackexchange.com/questions/60/… \$\endgroup\$ – Raystafarian Apr 25 '16 at 15:56
6
\$\begingroup\$

Doing something like this -

Dim YEAR_COL, TYPE_COL As String

Will dim YEAR_COL as variant and TYPE_COL as string. When you don't define your variable, VBA will declare it as a Variant, which are objects:

Performance. A variable you declare with the Object type is flexible enough to contain a reference to any object. However, when you invoke a method or property on such a variable, you always incur late binding (at run time). To force early binding (at compile time) and better performance, declare the variable with a specific class name, or cast it to the specific data type.

By not declaring variables, you could possibly be paying a penalty.

You need to type both-

`dim YEAR_COL as String, TYPE_COL as String

Or better, don't declare on the same line.


All of these UPPER_CASE_SNAKE variables should be CONST as that's what the upper case snake is for. If they aren't constants, don't violate Standard VBA naming conventions.


You don't need to Call subs, it's obsolete. Instead just use Sub argument, argument


What are all of those MYCOLOR1(i) and MYCOLOR2(i)? It's bad practice to use a number in your variable name and if these are constants - let them be constants. I also don't see the MYCOLOR() array defined anywhere. Always turn on Option Explicit. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know.


Why are these set with ""

CATEGORY_COL_NAME = ""
CATEGORY_COL_NAME2 = ""

If they are nothing strings, use vbNullString over "".


Hungarian notation - drop it

Dim strFile As String -> dim fileName as String

Variable names - try to give your variables meaningful names and you won't need the Hungarian notation.


These could probably be switched to SELECT CASE

If CATEGORY_TYPE = 3 

It's good practice to indent all of your code that way Labels will stick out as obvious. And it seems like you do have labels, somewhere. Those should be aligned all the way to the left.


Here you did define both types -

Dim col1 As Integer, col2 As Integer

But col1 and col2 tell me nothing about what's happening. Is it sourceColumn and targetColumn or something like thisthingColumn and thatthingColumn?


A huge source of your slow down will be working with data on the sheet rather than behind the scenes -

Selection.EntireColumn.AutoFit

Be sure to avoid things like .Select - it just slows the code down by needing to fiddle with the spreadsheet while doing everything else behind the scenes. There's a good question on StackOverflow addressing this - https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros .


I feel like reiterating this

Give your variables meaningful names

You don't pay per character, so why save 4 with col when it could be column? It's much more clear. src over source? curr over current? You catch the drift.


When working with sheets

Set src = Sheets(sheetName)
Set dest = Sheets(SER_FAT_PLOT_SHEET)

Worksheets have a CodeName property - View Properties window (F4) and the (Name) field can be used as the worksheet name. This way you can avoid Sheets("mySheet") and instead just use mySheet.


Your comments like

' copy formatting

Shouldn't be needed if your code is easy to follow, which it can be. Comments should only be used when you're doing something that needs explaining why you're doing it that way, not what you're doing or why you're doing it.

Comments - "code tell you how, comments tell you why". The code should speak for itself, if it needs a comment, it might need to be made more clear. If not, the comment should describe why you're doing something rather than how you're doing it. Here are a few reasons to avoid comments all together.


Private Sub CreateGraph1(ByRef var As Variant, ByVal chartName As String, ByVal gTop As Integer, ByVal title As String)

and

Private Sub CreateGraph2(ByRef var As Variant, ByVal chartName As String, ByVal gTop As Integer, ByVal title As String)

They have bad names - at least CreateFirstGraph or even better maybe extract a method or function and you won't need to duplicate the code, just call it when needed.


That's all I can really do now and please don't take it harshly. It looks like it's a lot of code from different places cobbled together - which is hard to maintain. But by following naming rules, spacing rules and other best practices, it will be much easier to follow and maintain.

I would also recommend checking out http://rubberduckvba.com/ - it has a lot of useful tools that might help you identify some of these things more easily. It's maintained by some users here at CodeReview - they even have a chat room.

| improve this answer | |
\$\endgroup\$
  • \$\begingroup\$ I changed the declaration to separate lines, Right now I am working with "Selection". Will change all the active sheets as you said slows the code down. Will keep you updated, how it works out. Thank you. \$\endgroup\$ – Cyclops Apr 25 '16 at 21:48
1
\$\begingroup\$

Constants

Good Decision:

Dim UPLOADED_DATA_SHEET_NAME As String
Dim CURR_YEAR_SHEET_NAME As String
Dim PREV_YEAR_SHEET_NAME As String

Static values should definitely be constants, and you've used the standard naming convention (namely SHOUTY_SNAKE_CASE) which is good.

Poor Decision:

Your constants are not, actually, constants. This is a constant:

Public Const UPLOADED_DATA_SHEET_NAME As String = "Uploaded Data"

Notice the Const keyword, and the requirement to declare the value when you create the constant. What you've created are just a bunch of global variables which can be changed as easily as typing

UPLOADED_DATA_SHEET_NAME = "Some other name"

by accident.


Naming

All sorts of stuff to go into here.

Names should be Descriptive, Unambiguous and Concise, in that order. Variables should sound like what they are.


Good Decision:

SPEED_COL_NAME = "Speed"

Personally, I recommend not abbreviated words. Screen real estate is cheap, mental processing is not. For the sake of 4 letters, you can instead write SPEED_COLUMN_TITLE and your brain doesn't have to do any extra processing to know what your variables is referring to, but that's a minor nitpick, it's a decent variable name.

Poor Decision:

SER_INJ_DATA_SHEET = "Data(Ser_Injuries)"

Too many unclear abbreviations. I'll probably figure out "Serious Injuries Data Sheet" but I'll have to stop and think for a second. Additionally, if you call something a SHEET I'm going to assume it's a Worksheet object. If it's a sheet name then it should sound like it. SERIOUS_INJURIES_SHEET_NAME is much clearer about what it is.


Actually, I've run out of good naming decisions to talk about, so here's some more poor ones:


Dim G_HEIGHT, G_WIDTH As Integer

What, exactly, are these meant to be? I'm going to guess that the G is short for Graph but I shouldn't have to guess.


Dim myColor1(12), myColor2(14) As Long

Completely useless names. They tell me nothing.

Dim colorsForDifferenceChart(12), colorsForTotalsChart(14) As Long

And suddenly they tell me everything.


Dim YEAR_COL, TYPE_COL As String

If I read YEAR_COL I'm going to think "Ah, that's the Year Column in string form, so, like, column "A", column "B" etc?" If it's a name or a title then it should say so. YEAR_COLUMN_TITLE is completely unambiguous about what it is.


What on earth is strFile?

strFile = Application.GetOpenFilename("Csv Files (*.csv), *.csv", , "Please select a CSV file")

Okay, so it's a filename. Next question. Why is a function that returns a filename called GetYearForComparison()? If I see a function called GetYear I'm going to assume it returns a year, like 2016 or 1066. If a function returns a filename it should make that clear.

GetFilenameOfComparisonYear, while a bit verbose, is so much easier to work with. I repeat, screen real estate is cheap, cognitive processing is not.

| improve this answer | |
\$\endgroup\$
  • \$\begingroup\$ I changed all the constant notations to Public_Const instead of Dim. Changed the "strFile" to "fileName". working on others. Current runtime before making all these changes was 1min and 52 secs. After making all the changes, its still at the same time. One more thing, when the plots are displayed, it is half invisible unless I click on it to display it. I don't know what should I do, to rectify this.Thank you. \$\endgroup\$ – Cyclops Apr 25 '16 at 21:51
  • \$\begingroup\$ In order to figure out how to make your program faster, I have to understand what it's doing first. That's never going to happen while it takes me half an hour just to get my head around the first 10% of your code (because confusing naming etc.). \$\endgroup\$ – Kaz Apr 26 '16 at 8:18
  • \$\begingroup\$ My best advice for making it faster is to start timing how long each of your subs take (can be done very simply with Debug.Print Now statements) and then isolate which of your subs (or sub-subs) is taking up all that time. \$\endgroup\$ – Kaz Apr 26 '16 at 8:19
  • \$\begingroup\$ I have edited the question. Putting in 1500 lines of code does not make sense, So I have attached a snippet of it and the problem that I am facing. \$\endgroup\$ – Cyclops Apr 26 '16 at 18:10
  • \$\begingroup\$ @Cyclops no no, please don't edit - meta.codereview.stackexchange.com/questions/1763/… \$\endgroup\$ – Raystafarian Apr 26 '16 at 18:25

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.