VBA/Macro For Excel 2010 to process 4 csv files and generate a graphical report (version 2)

Previous Post: http://naumankhan.blogspot.com/2010/12/vbamacro-for-excel-2010-to-process-4.html

   1: Sub Execute()

   2: '

   3: ' 20100102 - Ver2

   4: ' Nauman Khan, http://naumankhan.blogspot.com, naumankhan@bigfoot.com

   5: ' Changes in ver2

   6: ' - Changed date format which is used in filter to cater 1/1 instead of 01/01

   7: ' - Added logos on Main Menu and Output Report

   8:  

   9: Application.ScreenUpdating = False        ' to disable screen updating while macro is running

  10:  

  11: Dim Path1 As String     ' path of the input/template/report files

  12: Dim Filename1 As String     ' name of the FSHA input file

  13: Dim Filename2 As String     ' name of the FSHB input file

  14: Dim Filename3 As String     ' name of the FMRA input file

  15: Dim Filename4 As String     ' name of the FMRB input file

  16: Dim Filename5 As String     ' name of the output template file

  17: Dim Filename6 As String     ' name of the output report file

  18: Dim Date1 As String     ' date of data to be processed

  19: Dim Date2 As String     ' date for the filter

  20: Dim Date3 As String     ' date for the summary tab

  21: Dim Date4 As String     ' first date of the summary tab

  22: Dim Date5 As String     ' last date of the summary tab

  23: Dim Date6 As String     ' for chart title in summary tab

  24: Dim Date7 As String     ' month of the date for the filter

  25: Dim Date8 As String     ' day of the date for the filter

  26:  

  27: Sheets("Main Menu").Select      ' to read file names and date from main menu tab

  28: Filename1 = Range("C9").Text

  29: Filename2 = Range("C10").Text

  30: Filename3 = Range("C11").Text

  31: Filename4 = Range("C12").Text

  32: Filename5 = Range("C13").Text

  33: Date1 = Range("C15").Text

  34:  

  35: Filename6 = Left(Filename5, 32) + ".xlsx"       ' generating name of report file from template file

  36: Path1 = ThisWorkbook.Path + "\"     ' detecting path of template file

  37:  

  38: If Mid(Date1, 5, 2) < 10 Then       ' to remove the leading 0 of month of the date for the filter

  39:     Date7 = Mid(Date1, 6, 1)

  40: Else

  41:     Date7 = Mid(Date1, 5, 2)

  42: End If

  43:  

  44: If Right(Date1, 2) < 10 Then        ' to remove the leading 0 of day of the date for the filter

  45:     Date8 = Right(Date1, 1)

  46: Else

  47:     Date8 = Right(Date1, 2)

  48: End If

  49:  

  50: Date2 = Date7 + "/" + Date8 + "]"      ' Changing the format of date according to the one used in filter

  51: Date3 = Mid(Date1, 5, 2) + "/" + Right(Date1, 2) + "/" + Left(Date1, 4)     ' Changing the format of date according to the one used in summary tab

  52:  

  53: Windows(Filename5).Activate     ' moving the dates from the summary tab to one day back

  54: Sheets("Summary").Select

  55: Range("C23:E28").Select

  56: Selection.Copy

  57: Range("C22").Select

  58: ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _

  59:     IconFileName:=False

  60:  

  61: Sheets(Array("FSHA", "FSHB", "FMRA", "FMRB")).Select        ' to clear previous values of FSHA, FSHB, FMRA, FMRB tabs

  62: Range("A2:J289").Select

  63: Selection.ClearContents

  64:  

  65: '------------------------------------------------------------------------------------------

  66: Workbooks.Open Filename:=Path1 + Filename1      ' open FSHA input file

  67: Columns("A:A").Select       ' select 1st col and apply text to col using tab delimiter

  68: Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _

  69:     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _

  70:     Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _

  71:     :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _

  72:     Array(7, 1), Array(8, 1), Array(9, 1)), TrailingMinusNumbers:=True

  73: Columns("B:B").Select       ' select 2nd col and add an empty col

  74: Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

  75: Range("A1").FormulaR1C1 = "Time"        ' set cell A1 to time

  76: Columns("A:A").Select       ' select 1st col and apply text to col using space delimiter

  77: Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _

  78:     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _

  79:     Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _

  80:     :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

  81: Range("B1").Select      ' select cell B2 and set to date

  82: ActiveCell.FormulaR1C1 = "Date"

  83: Selection.AutoFilter        ' apply filter on cell B2 to filter out Date2

  84: ActiveSheet.Range(Cells(1, 1), Cells(Application.CountA(Range("A:A")), 9)).AutoFilter Field:=2, Criteria1:=Date2

  85: ActiveSheet.UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy     ' copy all filtered values

  86: Windows(Filename5).Activate     ' paste to FSHA tab

  87: Sheets("FSHA").Select

  88: Range("A2").Select

  89: ActiveSheet.Paste

  90: Application.CutCopyMode = Flase

  91: Workbooks(Filename1).Close savechanges:=False       ' close FSHA input file without saving the changes

  92:  

  93: '------------------------------------------------------------------------------------------

  94: Workbooks.Open Filename:=Path1 + Filename2      ' open FSHB input file

  95: Columns("A:A").Select       ' select 1st col and apply text to col using tab delimiter

  96: Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _

  97:     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _

  98:     Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _

  99:     :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _

 100:     Array(7, 1), Array(8, 1), Array(9, 1)), TrailingMinusNumbers:=True

 101: Columns("B:B").Select       ' select 2nd col and add an empty col

 102: Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

 103: Range("A1").FormulaR1C1 = "Time"        ' set cell A1 to time

 104: Columns("A:A").Select       ' select 1st col and apply text to col using space delimiter

 105: Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _

 106:     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _

 107:     Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _

 108:     :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

 109: Range("B1").Select      ' select cell B2 and set to date

 110: ActiveCell.FormulaR1C1 = "Date"

 111: Selection.AutoFilter        ' apply filter on cell B2 to filter out Date2

 112: ActiveSheet.Range(Cells(1, 1), Cells(Application.CountA(Range("A:A")), 9)).AutoFilter Field:=2, Criteria1:=Date2

 113: ActiveSheet.UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy     ' copy all filtered values

 114: Windows(Filename5).Activate     ' paste to FSHB tab

 115: Sheets("FSHB").Select

 116: Range("A2").Select

 117: ActiveSheet.Paste

 118: Application.CutCopyMode = Flase

 119: Workbooks(Filename2).Close savechanges:=False       ' close FSHB input file without saving the changes

 120:  

 121: '------------------------------------------------------------------------------------------

 122: Workbooks.Open Filename:=Path1 + Filename3      ' open FMRA input file

 123: Columns("A:A").Select       ' select 1st col and apply text to col using tab delimiter

 124: Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _

 125:     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _

 126:     Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _

 127:     :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _

 128:     Array(7, 1), Array(8, 1), Array(9, 1)), TrailingMinusNumbers:=True

 129: Columns("B:B").Select       ' select 2nd col and add an empty col

 130: Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

 131: Range("A1").FormulaR1C1 = "Time"        ' set cell A1 to time

 132: Columns("A:A").Select       ' select 1st col and apply text to col using space delimiter

 133: Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _

 134:     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _

 135:     Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _

 136:     :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

 137: Range("B1").Select      ' select cell B2 and set to date

 138: ActiveCell.FormulaR1C1 = "Date"

 139: Selection.AutoFilter        ' apply filter on cell B2 to filter out Date2

 140: ActiveSheet.Range(Cells(1, 1), Cells(Application.CountA(Range("A:A")), 9)).AutoFilter Field:=2, Criteria1:=Date2

 141: ActiveSheet.UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy     ' copy all filtered values

 142: Windows(Filename5).Activate     ' paste to FMRA tab

 143: Sheets("FMRA").Select

 144: Range("A2").Select

 145: ActiveSheet.Paste

 146: Application.CutCopyMode = Flase

 147: Workbooks(Filename3).Close savechanges:=False       ' close FMRA input file without saving the changes

 148:     

 149: '------------------------------------------------------------------------------------------

 150: Workbooks.Open Filename:=Path1 + Filename4      ' open FMRB input file

 151: Columns("A:A").Select       ' select 1st col and apply text to col using tab delimiter

 152: Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _

 153:     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _

 154:     Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _

 155:     :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _

 156:     Array(7, 1), Array(8, 1), Array(9, 1)), TrailingMinusNumbers:=True

 157: Columns("B:B").Select       ' select 2nd col and add an empty col

 158: Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

 159: Range("A1").FormulaR1C1 = "Time"        ' set cell A1 to time

 160: Columns("A:A").Select       ' select 1st col and apply text to col using space delimiter

 161: Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _

 162:     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _

 163:     Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _

 164:     :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

 165: Range("B1").Select      ' select cell B2 and set to date

 166: ActiveCell.FormulaR1C1 = "Date"

 167: Selection.AutoFilter        ' apply filter on cell B2 to filter out Date2

 168: ActiveSheet.Range(Cells(1, 1), Cells(Application.CountA(Range("A:A")), 9)).AutoFilter Field:=2, Criteria1:=Date2

 169: ActiveSheet.UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy     ' copy all filtered values

 170: Windows(Filename5).Activate     ' paste to FMRB tab

 171: Sheets("FMRB").Select

 172: Range("A2").Select

 173: ActiveSheet.Paste

 174: Application.CutCopyMode = Flase

 175: Workbooks(Filename4).Close savechanges:=False       ' close FMRB input file without saving the changes

 176:  

 177: '------------------------------------------------------------------------------------------

 178: Windows(Filename5).Activate     ' putting new date in summary tab

 179: Sheets("Summary").Select

 180: Range("C28").FormulaR1C1 = Date3

 181: Date4 = Range("C22").Text       ' generating date for the chart title

 182: Date5 = Range("C28").Text

 183: Date6 = "(" + Left(Date4, (InStr(1, Date4, ",") - 1)) + " - " + Right(Date5, 8) + ")"

 184:  

 185: ActiveSheet.ChartObjects("Chart 1").Activate        ' updating date in chart title

 186: ActiveChart.ChartTitle.Select

 187: ActiveChart.ChartTitle.Text = "MT SMS Transactions" & Chr(13) & Date6

 188: Selection.Format.TextFrame2.TextRange.Characters.Text = _

 189:     "MT SMS Transactions" & Chr(13) & Date6

 190: With Selection.Format.TextFrame2.TextRange.Characters(1, 20).ParagraphFormat

 191:     .TextDirection = msoTextDirectionLeftToRight

 192:     .Alignment = msoAlignCenter

 193: End With

 194: With Selection.Format.TextFrame2.TextRange.Characters(1, 20).Font

 195:     .BaselineOffset = 0

 196:     .Bold = msoTrue

 197:     .NameComplexScript = "+mn-cs"

 198:     .NameFarEast = "+mn-ea"

 199:     .Fill.Visible = msoTrue

 200:     .Fill.ForeColor.RGB = RGB(0, 0, 0)

 201:     .Fill.Transparency = 0

 202:     .Fill.Solid

 203:     .Size = 16

 204:     .Italic = msoFalse

 205:     .Kerning = 12

 206:     .Name = "+mn-lt"

 207:     .UnderlineStyle = msoNoUnderline

 208:     .Strike = msoNoStrike

 209: End With

 210: With Selection.Format.TextFrame2.TextRange.Characters(21, 24).ParagraphFormat

 211:     .TextDirection = msoTextDirectionLeftToRight

 212:     .Alignment = msoAlignCenter

 213: End With

 214: With Selection.Format.TextFrame2.TextRange.Characters(21, 24).Font

 215:     .BaselineOffset = 0

 216:     .Bold = msoTrue

 217:     .NameComplexScript = "+mn-cs"

 218:     .NameFarEast = "+mn-ea"

 219:     .Fill.Visible = msoTrue

 220:     .Fill.ForeColor.RGB = RGB(0, 0, 0)

 221:     .Fill.Transparency = 0

 222:     .Fill.Solid

 223:     .Size = 12

 224:     .Italic = msoFalse

 225:     .Kerning = 12

 226:     .Name = "+mn-lt"

 227:     .UnderlineStyle = msoNoUnderline

 228:     .Strike = msoNoStrike

 229: End With

 230:  

 231: Range("A1").Select      ' selecting first cell in summary tab

 232: Sheets("Main Menu").Select      ' selecting main menu

 233: Range("A1").Select      ' selecting first cell in main menu tab

 234:  

 235: Application.DisplayAlerts = False       ' disabling all notifications

 236: Workbooks.Add.SaveAs Filename:=Path1 + Filename6        ' generating report file

 237: Windows(Filename5).Activate

 238: Sheets("Summary").Copy Before:=Workbooks(Filename6).Sheets(1)       ' copying summary tab from template to report file

 239: Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select      ' deleting remaining tabs from report file

 240: ActiveWindow.SelectedSheets.Delete

 241: ActiveWorkbook.Save     ' saving report file

 242: Application.DisplayAlerts = True        ' enabling all notifications

 243:  

 244: Application.ScreenUpdating = True     ' to enable screen updating while macro is running

 245: End Sub

References:

if statement

http://www.anthony-vba.kefra.com/vba/vbabasic3.htm#Decision_Structures_-_IF_and_Select_Case

-urShadow