Pages

Sunday, December 26, 2010

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

References:


to chk the path of any file:


http://www.ozgrid.com/VBA/WorkbookPath.htm


to find the count of rows


http://www.mrexcel.com/forum/showthread.php?t=46148


Copy All Filtered Rows after Header

http://www.mrexcel.com/archive/Data/10541.html


Extract Substring from the Middle of a String

http://www.example-code.com/vb/mid.asp


http://www.xtremevbtalk.com/showthread.php?t=277326


http://www.techonthenet.com/excel/formulas/instr.php


Creating a New Workbook

http://msdn.microsoft.com/en-us/library/aa221273%28v=office.11%29.aspx


Delete sheets without confirmation prompts

http://www.exceltip.com/st/Delete_sheets_without_confirmation_prompts_using_VBA_in_Microsoft_Excel/483.html

Protect/Lock Visual Basic Editor (VBE)

http://www.ozgrid.com/VBA/protect-vba-code.htm


VBA code to save workbook with no prompt


http://www.mrexcel.com/forum/showthread.php?t=67564


-urShadow

No comments:

Post a Comment