Below is the code that is split into two macros- CollateData1 and GenerateGraphs2. These first collate data from multiple spreadsheets into one, and then compiles the data to generate numerous relevant graphs. There are hundreds of excel files and I need to go through each of them and create some reports and graphs based on the content of them. However, it's extremely difficult to debug with the built-in excel vba debugger. Also, when the filename has a "-" in it, the macro stops working. How do I fix this? Below is the full code of the macro.
Sub CollateData1()
Dim sFolder As String
Dim FileName As String, sh As Worksheet
Dim rng As Range, row As Range, cell As Range, Name As String, dt As Date
Dim i As Integer, j As Integer, notEmpty As Boolean
i = 1
Application.StatusBar = "Importing data from Spreadsheets..."
reportName = ActiveWorkbook.Name
Set reportSheet = ActiveWorkbook.ActiveSheet
reportSheet.Range("A1").Value = "Name"
Range("B1").Value = "Date"
Range("C1").Value = "Project/Initiative Name"
Range("D1").Value = "Category of Activity"
Range("E1").Value = "Activity"
Range("F1").Value = "No. of Test Cases"
Range("G1").Value = "Complexity"
Range("H1").Value = "Time Taken (mins)"
Range("I1").Value = "Remarks/Ideas"
' Open the select folder prompt
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then ' if OK is pressed
sFolder = .SelectedItems(1)
End If
End With
If sFolder <> "" Then ' if a file was chosen
FileName = Dir(sFolder & "\*.xl??")
Do While FileName <> ""
Workbooks.Open (sFolder & Application.PathSeparator & FileName) ' or try Workbooks.Open (directory & FileName)
For Each sh In Workbooks(FileName).Worksheets
If sh.Name <> "Instructions" And sh.Name <> "Weekly Summary" Then
Name = sh.Range("C3").Value ' check cell
dt = sh.Range("C7").Value ' check cell
Set rng = sh.Range("B17:H20") ' check cell
For Each row In rng.Rows
notEmpty = False
j = 3
For Each cell In row.Cells
If cell.Value <> "" Then
If notEmpty = False Then
notEmpty = True
i = i + 1
reportSheet.Cells(i, 1).Value = Name
reportSheet.Cells(i, 2).Value = dt
End If
reportSheet.Cells(i, j).Value = cell.Value
End If
j = j + 1
Next cell
Next row
End If
Next sh
Workbooks(FileName).Close
FileName = Dir()
Loop
End If
End Sub
Sub GenerateGraphs2()
Application.StatusBar = "Generating Graphs from Collated Data..."
Dim reportName As String, reportSheet As Worksheet, foundRng As Range
reportName = ActiveWorkbook.Name
ActiveSheet.Name = "Data"
Sheets.Add.Name = "Summary"
Dim last As Integer, mindate As Date, maxdate As Date, r As Integer, m As Integer
' Sheets("Summary").Range("A1").Value = "Name/Date"
last = WorksheetFunction.CountA(Sheets("Data").Columns(1))
Sheets("Data").Range("A1:A" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Summary").Range("A1"), Unique:=True
mindate = WorksheetFunction.Min(Sheets("Data").Range("B2:B" & last))
maxdate = WorksheetFunction.Max(Sheets("Data").Range("B2:B" & last))
r = 3
Do
Sheets("Summary").Cells(1, r).Value = mindate
mindate = mindate + 1
r = r + 1
Loop Until mindate > maxdate
mindate = WorksheetFunction.Min(Sheets("Data").Range("B2:B" & last))
For m = 3 To DateDiff("D", mindate, maxdate) + 3
For r = 2 To last
If Sheets("Summary").Cells(1, m).Value = Sheets("Data").Cells(r, 2).Value Then
Set foundRng = Range("A:A").Find(Sheets("Data").Cells(r, 1).Value)
Sheets("Summary").Cells(foundRng.row, m).Value = Sheets("Summary").Cells(foundRng.row, m).Value + Sheets("Data").Cells(r, 6).Value
End If
Next
Next
Range("B2").Formula = "=SUM($C2:$" & Cells(2, DateDiff("D", mindate, maxdate) + 3).Address(0, 0) & ")"
Range("B2:B" & WorksheetFunction.CountA(Sheets("Summary").Columns(1))).FillDown
Range("A2:B" & WorksheetFunction.CountA(Sheets("Summary").Columns(1))).Select
ActiveSheet.Shapes.AddChart2(216, xlBarClustered).Select
ActiveChart.SetSourceData Source:=Range("Summary!$A$2:$B$" & WorksheetFunction.CountA(Sheets("Summary").Columns(1)))
ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Text = "Number of Test Cases (" & mindate & " - " & maxdate & ")"
Selection.Format.TextFrame2.TextRange.Characters.Text = _
"Number of Test Cases (" & mindate & " - " & maxdate & ")"
ActiveChart.PlotVisibleOnly = False
With ActiveChart.Parent
.Width = 650
.Height = 600
.Top = 1700
.Left = 300
End With
With Selection.Format.TextFrame2.TextRange.Characters(1, 40).ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
With Selection.Format.TextFrame2.TextRange.Characters(1, 30).Font
.BaselineOffset = 0
.Bold = msoFalse
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(89, 89, 89)
.Fill.Transparency = 0
.Fill.Solid
.Size = 14
.Italic = msoFalse
.Kerning = 12
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Spacing = 0
.Strike = msoNoStrike
End With
With Selection.Format.TextFrame2.TextRange.Characters(31, 10).Font
.BaselineOffset = 0
.Bold = msoFalse
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(89, 89, 89)
.Fill.Transparency = 0
.Fill.Solid
.Size = 14
.Italic = msoFalse
.Kerning = 12
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Spacing = 0
.Strike = msoNoStrike
End With
ActiveChart.ChartArea.Select
ActiveChart.FullSeriesCollection(1).Select
ActiveChart.FullSeriesCollection(1).ApplyDataLabels
ActiveChart.ChartArea.Select
ActiveChart.FullSeriesCollection(1).DataLabels.Select
Selection.Position = xlLabelPositionInsideEnd
With Selection.Format.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Solid
End With
Sheets.Add.Name = "Individual"
For r = 2 To WorksheetFunction.CountA(Sheets("Summary").Columns(1))
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=Sheets("Summary").Range("Summary!$A$1,Summary!$C$1:" & Cells(1, WorksheetFunction.CountA(Sheets("Summary").Rows(1)) + 1).Address & ",Summary!$A$" & r & ",Summary!$C$" & r & ":" & Cells(r, WorksheetFunction.CountA(Sheets("Summary").Rows(1)) + 1).Address)
ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Text = Sheets("Summary").Range("A" & r).Value & " - Test Cases Executed"
Selection.Format.TextFrame2.TextRange.Characters.Text = _
Sheets("Summary").Range("A" & r).Value & " - Test Cases Executed"
ActiveChart.PlotVisibleOnly = False
With ActiveChart.Parent
.Width = 650
.Height = 600
.Top = 1700
.Left = 25 + 675 * (r - 2)
End With
With Selection.Format.TextFrame2.TextRange.Characters(1, 28).ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
With Selection.Format.TextFrame2.TextRange.Characters(1, 28).Font
.BaselineOffset = 0
.Bold = msoFalse
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(89, 89, 89)
.Fill.Transparency = 0
.Fill.Solid
.Size = 14
.Italic = msoFalse
.Kerning = 12
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Spacing = 0
.Strike = msoNoStrike
End With
Next r
' Create Graphs
Dim Names As Variant, u As Integer, t As Integer
last = WorksheetFunction.CountA(Sheets("Data").Columns(1))
Sheets("Data").Range("D2:D" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Individual").Range("A2"), Unique:=True
Names = Sheets("Summary").Range("A2:A" & last).Value
For u = 2 To UBound(Names)
If Names(u - 1, 1) <> "" Then
Sheets("Individual").Range(Cells(1, u).Address).Value = Names(u - 1, 1)
For t = 2 To WorksheetFunction.CountA(Sheets("Individual").Columns(1)) + 1
' Sheets("Individual").Range(Cells(t, u).Address).Value = WorksheetFunction.SumIfs("Data!H:H", "Data!D:D", "Data!A" & t, "A:A", Cells(1, u).Address)
Sheets("Individual").Range(Cells(t, u).Address).Value = WorksheetFunction.SumIfs(Sheets("Data").Range("$H:$H"), Sheets("Data").Range("$D:$D"), Sheets("Individual").Range("A" & t).Value, Sheets("Data").Range("$A:$A"), Sheets("Individual").Range(Cells(1, u).Address).Value)
Next t
ActiveSheet.Shapes.AddChart2(251, xlPie).Select
ActiveChart.PlotVisibleOnly = False
With ActiveChart.Parent
.Width = 650
.Height = 600
.Top = 1700 + 600 + 17
.Left = 25 + 675 * (u - 2)
End With
ActiveChart.SetSourceData Source:=Range( _
"Individual!$A$1:$A$" & t - 1 & "," & Range(Cells(1, u), Cells(t - 1, u)).Address)
ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Text = Names(u - 1, 1) & " - Activity Split-Up (" & mindate & " - " & maxdate & ")"
Selection.Format.TextFrame2.TextRange.Characters.Text = _
Names(u - 1, 1) & " - Activity Split-Up (" & mindate & " - " & maxdate & ")"
With Selection.Format.TextFrame2.TextRange.ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
With Selection.Format.TextFrame2.TextRange.Font
.BaselineOffset = 0
.Bold = msoFalse
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(89, 89, 89)
.Fill.Transparency = 0
.Fill.Solid
.Size = 14
.Italic = msoFalse
.Kerning = 12
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Spacing = 0
.Strike = msoNoStrike
End With
ActiveChart.ChartArea.Select
ActiveChart.ChartTitle.Select
With Selection.Format.TextFrame2.TextRange.Font
.BaselineOffset = 0
.Size = 20
End With
ActiveChart.Legend.Select
With Selection.Format.TextFrame2.TextRange.Font
.BaselineOffset = 0
.Size = 14
End With
ActiveChart.FullSeriesCollection(1).Select
ActiveChart.FullSeriesCollection(1).ApplyDataLabels
ActiveChart.FullSeriesCollection(1).DataLabels.Select
Selection.ShowPercentage = True
Selection.ShowCategoryName = True
With Selection.Format.TextFrame2.TextRange.Font
.BaselineOffset = 0
.Size = 15
End With
Selection.Separator = "" & Chr(13) & ""
' Selection.ShowValue = False
End If
Next u
' Hide Rows
For u = 1 To 100
Sheets("Individual").Rows(u).EntireRow.Hidden = True
Sheets("Summary").Rows(u).EntireRow.Hidden = True
Next u
Application.StatusBar = False
End Sub