urShadow's Blog: 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