urShadow's Blog: VBA/Macro For Excel 2010 to process 4 csv files and generate a graphical report

   1: Sub Execute()   2: '   3: ' 20101222 - Ver1   4: ' Nauman Khan, http://naumankhan.blogspot.com, naumankhan@bigfoot.com   5:     6: Application.ScreenUpdating = False        ' to disable screen updating while macro is running   7:     8: Dim Path1 As String     ' path of the input/template/report files   9: Dim Filename1 As String     ' name of the FSHA input file  10: Dim Filename2 As String     ' name of the FSHB input file  11: Dim Filename3 As String     ' name of the FMRA input file  12: Dim Filename4 As String     ' name of the FMRB input file  13: Dim Filename5 As String     ' name of the output template file  14: Dim Filename6 As String     ' name of the output report file  15: Dim Date1 As String     ' date of data to be processed  16: Dim Date2 As String     ' date for the filter  17: Dim Date3 As String     ' date for the summary tab  18: Dim Date4 As String     ' first date of the summary tab  19: Dim Date5 As String     ' last date of the summary tab  20: Dim Date6 As String     ' for chart title in summary tab  21:    22: Sheets("Main Menu").Select      ' to read file names and date from main menu tab  23: Filename1 = Range("C5").Text  24: Filename2 = Range("C6").Text  25: Filename3 = Range("C7").Text  26: Filename4 = Range("C8").Text  27: Filename5 = Range("C9").Text  28: Date1 = Range("C11").Text  29:    30: Filename6 = Left(Filename5, 32) + ".xlsx"       ' generating name of report file from template file  31: Path1 = ThisWorkbook.Path + "\"     ' detecting path of template file  32: Date2 = Mid(Date1, 5, 2) + "/" + Right(Date1, 2) + "]"      ' Changing the format of date according to the one used in filter  33: Date3 = Mid(Date1, 5, 2) + "/" + Right(Date1, 2) + "/" + Left(Date1, 4)     ' Changing the format of date according to the one used in summary tab  34:    35: Windows(Filename5).Activate     ' moving the dates from the summary tab to one day back  36: Sheets("Summary").Select  37: Range("C23:E28").Select  38: Selection.Copy  39: Range("C22").Select  40: ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _  41:     IconFileName:=False  42:    43: Sheets(Array("FSHA", "FSHB", "FMRA", "FMRB")).Select        ' to clear previous values of FSHA, FSHB, FMRA, FMRB tabs  44: Range("A2:J289").Select  45: Selection.ClearContents  46:    47: '------------------------------------------------------------------------------------------  48: Workbooks.Open Filename:=Path1 + Filename1      ' open FSHA input file  49: Columns("A:A").Select       ' select 1st col and apply text to col using tab delimiter  50: Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _  51:     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _  52:     Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _  53:     :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _  54:     Array(7, 1), Array(8, 1), Array(9, 1)), TrailingMinusNumbers:=True  55: Columns("B:B").Select       ' select 2nd col and add an empty col  56: Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove  57: Range("A1").FormulaR1C1 = "Time"        ' set cell A1 to time  58: Columns("A:A").Select       ' select 1st col and apply text to col using space delimiter  59: Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _  60:     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _  61:     Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _  62:     :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True  63: Range("B1").Select      ' select cell B2 and set to date  64: ActiveCell.FormulaR1C1 = "Date"  65: Selection.AutoFilter        ' apply filter on cell B2 to filter out Date2  66: ActiveSheet.Range(Cells(1, 1), Cells(Application.CountA(Range("A:A")), 9)).AutoFilter Field:=2, Criteria1:=Date2  67: ActiveSheet.UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy     ' copy all filtered values  68: Windows(Filename5).Activate     ' paste to FSHA tab  69: Sheets("FSHA").Select  70: Range("A2").Select  71: ActiveSheet.Paste  72: Application.CutCopyMode = Flase  73: Workbooks(Filename1).Close savechanges:=False       ' close FSHA input file without saving the changes  74:    75: '------------------------------------------------------------------------------------------  76: Workbooks.Open Filename:=Path1 + Filename2      ' open FSHB input file  77: Columns("A:A").Select       ' select 1st col and apply text to col using tab delimiter  78: Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _  79:     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _  80:     Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _  81:     :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _  82:     Array(7, 1), Array(8, 1), Array(9, 1)), TrailingMinusNumbers:=True  83: Columns("B:B").Select       ' select 2nd col and add an empty col  84: Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove  85: Range("A1").FormulaR1C1 = "Time"        ' set cell A1 to time  86: Columns("A:A").Select       ' select 1st col and apply text to col using space delimiter  87: Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _  88:     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _  89:     Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _  90:     :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True  91: Range("B1").Select      ' select cell B2 and set to date  92: ActiveCell.FormulaR1C1 = "Date"  93: Selection.AutoFilter        ' apply filter on cell B2 to filter out Date2  94: ActiveSheet.Range(Cells(1, 1), Cells(Application.CountA(Range("A:A")), 9)).AutoFilter Field:=2, Criteria1:=Date2  95: ActiveSheet.UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy     ' copy all filtered values  96: Windows(Filename5).Activate     ' paste to FSHB tab  97: Sheets("FSHB").Select  98: Range("A2").Select  99: ActiveSheet.Paste 100: Application.CutCopyMode = Flase 101: Workbooks(Filename2).Close savechanges:=False       ' close FSHB input file without saving the changes 102:   103: '------------------------------------------------------------------------------------------ 104: Workbooks.Open Filename:=Path1 + Filename3      ' open FMRA input file 105: Columns("A:A").Select       ' select 1st col and apply text to col using tab delimiter 106: Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ 107:     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ 108:     Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _ 109:     :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _ 110:     Array(7, 1), Array(8, 1), Array(9, 1)), TrailingMinusNumbers:=True 111: Columns("B:B").Select       ' select 2nd col and add an empty col 112: Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 113: Range("A1").FormulaR1C1 = "Time"        ' set cell A1 to time 114: Columns("A:A").Select       ' select 1st col and apply text to col using space delimiter 115: Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ 116:     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ 117:     Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _ 118:     :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True 119: Range("B1").Select      ' select cell B2 and set to date 120: ActiveCell.FormulaR1C1 = "Date" 121: Selection.AutoFilter        ' apply filter on cell B2 to filter out Date2 122: ActiveSheet.Range(Cells(1, 1), Cells(Application.CountA(Range("A:A")), 9)).AutoFilter Field:=2, Criteria1:=Date2 123: ActiveSheet.UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy     ' copy all filtered values 124: Windows(Filename5).Activate     ' paste to FMRA tab 125: Sheets("FMRA").Select 126: Range("A2").Select 127: ActiveSheet.Paste 128: Application.CutCopyMode = Flase 129: Workbooks(Filename3).Close savechanges:=False       ' close FMRA input file without saving the changes 130:      131: '------------------------------------------------------------------------------------------ 132: Workbooks.Open Filename:=Path1 + Filename4      ' open FMRB input file 133: Columns("A:A").Select       ' select 1st col and apply text to col using tab delimiter 134: Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ 135:     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ 136:     Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _ 137:     :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _ 138:     Array(7, 1), Array(8, 1), Array(9, 1)), TrailingMinusNumbers:=True 139: Columns("B:B").Select       ' select 2nd col and add an empty col 140: Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 141: Range("A1").FormulaR1C1 = "Time"        ' set cell A1 to time 142: Columns("A:A").Select       ' select 1st col and apply text to col using space delimiter 143: Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ 144:     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ 145:     Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _ 146:     :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True 147: Range("B1").Select      ' select cell B2 and set to date 148: ActiveCell.FormulaR1C1 = "Date" 149: Selection.AutoFilter        ' apply filter on cell B2 to filter out Date2 150: ActiveSheet.Range(Cells(1, 1), Cells(Application.CountA(Range("A:A")), 9)).AutoFilter Field:=2, Criteria1:=Date2 151: ActiveSheet.UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy     ' copy all filtered values 152: Windows(Filename5).Activate     ' paste to FMRB tab 153: Sheets("FMRB").Select 154: Range("A2").Select 155: ActiveSheet.Paste 156: Application.CutCopyMode = Flase 157: Workbooks(Filename4).Close savechanges:=False       ' close FMRB input file without saving the changes 158:   159: '------------------------------------------------------------------------------------------ 160: Windows(Filename5).Activate     ' putting new date in summary tab 161: Sheets("Summary").Select 162: Range("C28").FormulaR1C1 = Date3 163: Date4 = Range("C22").Text       ' generating date for the chart title 164: Date5 = Range("C28").Text 165: Date6 = "(" + Left(Date4, (InStr(1, Date4, ",") - 1)) + " - " + Right(Date5, 8) + ")" 166:   167: ActiveSheet.ChartObjects("Chart 1").Activate        ' updating date in chart title 168: ActiveChart.ChartTitle.Select 169: ActiveChart.ChartTitle.Text = "MT SMS Transactions" & Chr(13) & Date6 170: Selection.Format.TextFrame2.TextRange.Characters.Text = _ 171:     "MT SMS Transactions" & Chr(13) & Date6 172: With Selection.Format.TextFrame2.TextRange.Characters(1, 20).ParagraphFormat 173:     .TextDirection = msoTextDirectionLeftToRight 174:     .Alignment = msoAlignCenter 175: End With 176: With Selection.Format.TextFrame2.TextRange.Characters(1, 20).Font 177:     .BaselineOffset = 0 178:     .Bold = msoTrue 179:     .NameComplexScript = "+mn-cs" 180:     .NameFarEast = "+mn-ea" 181:     .Fill.Visible = msoTrue 182:     .Fill.ForeColor.RGB = RGB(0, 0, 0) 183:     .Fill.Transparency = 0 184:     .Fill.Solid 185:     .Size = 16 186:     .Italic = msoFalse 187:     .Kerning = 12 188:     .Name = "+mn-lt" 189:     .UnderlineStyle = msoNoUnderline 190:     .Strike = msoNoStrike 191: End With 192: With Selection.Format.TextFrame2.TextRange.Characters(21, 24).ParagraphFormat 193:     .TextDirection = msoTextDirectionLeftToRight 194:     .Alignment = msoAlignCenter 195: End With 196: With Selection.Format.TextFrame2.TextRange.Characters(21, 24).Font 197:     .BaselineOffset = 0 198:     .Bold = msoTrue 199:     .NameComplexScript = "+mn-cs" 200:     .NameFarEast = "+mn-ea" 201:     .Fill.Visible = msoTrue 202:     .Fill.ForeColor.RGB = RGB(0, 0, 0) 203:     .Fill.Transparency = 0 204:     .Fill.Solid 205:     .Size = 12 206:     .Italic = msoFalse 207:     .Kerning = 12 208:     .Name = "+mn-lt" 209:     .UnderlineStyle = msoNoUnderline 210:     .Strike = msoNoStrike 211: End With 212:   213: Range("A1").Select      ' selecting first cell in summary tab 214: Sheets("Main Menu").Select      ' selecting main menu 215: Range("A1").Select      ' selecting first cell in main menu tab 216:   217: Application.DisplayAlerts = False       ' disbaling all notifications 218: Workbooks.Add.SaveAs Filename:=Path1 + Filename6        ' generating report file 219: Windows(Filename5).Activate 220: Sheets("Summary").Copy Before:=Workbooks(Filename6).Sheets(1)       ' copying summary tab from template to report file 221: Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select      ' deleting remaining tabs from report file 222: ActiveWindow.SelectedSheets.Delete 223: ActiveWorkbook.Save     ' saving report file 224: Application.DisplayAlerts = True        ' enabling all notifications 225:   226: Application.ScreenUpdating = True     ' to enable screen updating while macro is running 227: End Sub