I have this code to import a load of data from various external workbooks which contain information that needs collating. The code, as suggested by the heading, works on occasion but if I re-run the code, it fails. The Poller and Notifications data requires an extra line between two sets of data. My code seems to fail here - sometimes it inserts, sometimes it doesn't - which then makes the Summary incorrect. Is anyone able to spot a way of ensuring the lines are always inserted?
Thanks in advance
Code:
Sub ImportSheets()
Dim Path As String 'string variable to hold the path to look through
Dim mWB As Workbook 'master workbook
Dim aWS As Worksheet 'active sheet in master workbook
Dim rPath As String
Dim pPath As String
Dim nPath As String
Dim dT As Date
Dim rDate As String
Dim pDate As String
Dim nDate As String
Path = "C:\Documents and Settings\" & Application.UserName & "\Desktop\Response Times"
dT = DateValue("24 Mar 2013")
Application.EnableEvents = False 'turn off events
Application.ScreenUpdating = False 'turn off screen updating
Application.Calculation = xlCalculationManual
Set mWB = ThisWorkbook 'stores information in open workbook
' **** Do Ram Analysis Timings ****
rPath = Path & "\RAS"
mWB.Worksheets("RAM Timings").Cells.Clear
Set aWS = mWB.Worksheets("RAM Timings")
rDate = Format(dT, "dd-mm-yyyy")
RAMTimings rPath, aWS, rDate, mWB
' **** Do Poller ****
mWB.Worksheets("Poller").Cells.Clear
Set aWS = mWB.Worksheets("Poller")
pDate = Format(dT, "yyyy-mm-dd")
PollerStats Path, aWS, pDate, mWB
' **** Do Notifications ****
nPath = Path & "\Notifications\"
mWB.Worksheets("Notifications").Cells.Clear
Set aWS = mWB.Worksheets("Notifications")
nDate = Format(dT, "dd-mm-yyyy")
Notifications nPath, aWS, nDate, mWB
' Update Summary
Sheets("Summary").Range("B2").Value = DateAdd("d", -6, dT) & "-" & dT
mWB.Sheets("Summary").Select 'select summary sheet on master workbook
Application.EnableEvents = True 're-enable events
Application.ScreenUpdating = True 'turn screen updating back on
Application.Calculation = xlCalculationAutomatic
Set mWB = Nothing
Set aWS = Nothing
End Sub
'--------
Sub RAMTimings(Path As String, Sht, Dat, WBM)
Dim FileName As String 'temporary filename string variable
Dim sPath As String
Dim tWB As Workbook 'temporary workbook (each in directory)
Dim tWS As Worksheet 'temporary worksheet variable
Dim uRange As Range 'usedrange for each temporary sheet
Dim RowCount As Long 'Rows used on master sheet
Dim tDate As Date
Dim sDat As String
Dim c As Integer
sDat = Dat
For k = 1 To 7 'Loop through Maps
sPath = Path & "\Map" & k
For j = 1 To 2 'Loop through Third & Fourth folders
If j = 1 Then
sPath = sPath & "\fourth\"
Else
sPath = sPath & "\third\"
End If
For i = 1 To 7 'Loop through 7 days
FileName = Dir(sPath & "ram-based-analysistimings-" & sDat & ".csv", vbNormal)
Do Until FileName = "" 'loop until all files have been parsed
If Path <> ThisWorkbook.Path Or FileName <> ThisWorkbook.Name Then
Set tWB = Workbooks.Open(FileName:=sPath & FileName) 'open file, set to tWB variable
For Each tWS In tWB.Worksheets 'loop through each sheet
Set uRange = tWS.Range("A2", tWS.Cells(tWS.UsedRange.Row + tWS.UsedRange.Rows _
.Count - 1, tWS.UsedRange.Column + tWS.UsedRange.Columns.Count - 1)) 'set used range
If RowCount + uRange.Rows.Count > 65536 Then 'if the used range wont fit on the sheet
Sht.Columns.AutoFit 'autofit mostly-used worksheet's columns
Set Sht = WBM.Sheets.Add(After:=Sht) 'add a new sheet that will accommodate data
RowCount = 0 'reset RowCount variable
End If
If RowCount = 0 Then 'if working with a new sheet
Sht.Range("A1", Sht.Cells(1, uRange.Columns.Count)).Value = _
tWS.Range("A1", tWS.Cells(1, uRange.Columns.Count)).Value 'copy headers from tWS
RowCount = 1 'add one to rowcount
End If
Sht.Range("A" & RowCount + 1).Resize(uRange.Rows.Count, uRange.Columns.Count).Value _
= uRange.Value 'move data from temp sheet to data sheet
RowCount = RowCount + uRange.Rows.Count 'increase rowcount accordingly
Next
tDate = DateValue(sDat)
tDate = DateAdd("d", -1, tDate)
sDat = Format(tDate, "dd-mm-yyyy")
tWB.Close False 'close temporary workbook without saving
End If
FileName = Dir() 'set next file's name to FileName variable
Loop
Next i
sDat = Dat
sPath = Path & "\Map" & k
Next j
Next k
With Sheets("RAM Timings")
Dim lastR As Integer
lastR = .UsedRange.Rows.Count
.Range("C1") = "> 0.5s"
.Range("D1") = "> 1.0s"
.Range("E1") = "Count"
For c = 2 To .Range("A1").End(xlDown).Row
If .Range("B" & c) > 500 Then
.Range("C" & c) = 1
Else
.Range("C" & c) = 0
End If
If .Range("B" & c) > 1000 Then
.Range("D" & c) = 1
Else
.Range("D" & c) = 0
End If
.Range("E" & c) = c - 1
Next c
MsgBox "Getting RAM Timings calculations"
.Range("B" & lastR + 1) = "=average(B2:B" & lastR & ")/1000"
.Range("C" & lastR + 1) = "=sum(C2:C" & lastR & ")"
.Range("D" & lastR + 1) = "=sum(D2:D" & lastR & ")"
Sheets("Summary").Range("B4").Value = .Range("B" & lastR + 1).Value
Sheets("Summary").Range("B5").Value = .Range("E" & lastR).Value
Sheets("Summary").Range("B6").Value = .Range("C" & lastR + 1).Value
Sheets("Summary").Range("B7").Value = .Range("D" & lastR + 1).Value
End With
Set tWB = Nothing
Set tWS = Nothing
'Set WBM = Nothing
Set Sht = Nothing
Set uRange = Nothing
End Sub
'--------
Sub PollerStats(Path As String, Sht, Dat, WBM)
Dim FileName As String 'temporary filename string variable
Dim sPath As String
Dim tWB As Workbook 'temporary workbook (each in directory)
Dim tWS As Worksheet 'temporary worksheet variable
Dim uRange As Range 'usedrange for each temporary sheet
Dim RowCount As Long 'Rows used on master sheet
Dim tDate As Date
Dim sDat As String
Dim c As Integer
sDat = Dat
For k = 1 To 2 'Loop through Poller folders
If k = 1 Then
sPath = Path & "\Port3avpoller\"
Else
sPath = Path & "\Port4avpoller\"
End If
For i = 1 To 7 'Loop through 7 days
FileName = Dir(sPath & "\" & sDat & "-data.csv", vbNormal)
Do Until FileName = "" 'loop until all files have been parsed
If Path <> ThisWorkbook.Path Or FileName <> ThisWorkbook.Name Then
Set tWB = Workbooks.Open(FileName:=sPath & FileName) 'open file, set to tWB variable
For Each tWS In tWB.Worksheets 'loop through each sheet
Set uRange = tWS.Range("A2", tWS.Cells(tWS.UsedRange.Row + tWS.UsedRange.Rows _
.Count - 1, tWS.UsedRange.Column + tWS.UsedRange.Columns.Count - 1)) 'set used range
If RowCount + uRange.Rows.Count > 65536 Then 'if the used range wont fit on the sheet
Sht.Columns.AutoFit 'autofit mostly-used worksheet's columns
Set Sht = WBM.Sheets.Add(After:=Sht) 'add a new sheet that will accommodate data
RowCount = 0 'reset RowCount variable
End If
If RowCount = 0 Then 'if working with a new sheet
Sht.Range("A1", Sht.Cells(1, uRange.Columns.Count)).Value = _
tWS.Range("A1", tWS.Cells(1, uRange.Columns.Count)).Value 'copy headers from tWS
RowCount = 1 'add one to rowcount
End If
Sht.Range("A" & RowCount + 1).Resize(uRange.Rows.Count, uRange.Columns.Count).Value _
= uRange.Value 'move data from temp sheet to data sheet
RowCount = RowCount + uRange.Rows.Count 'increase rowcount accordingly
Next
tDate = DateValue(sDat)
tDate = DateAdd("d", -1, tDate)
sDat = Format(tDate, "yyyy-mm-dd")
tWB.Close False 'close temporary workbook without saving
End If
FileName = Dir() 'set next file's name to FileName variable
Loop
Next i
sDat = Dat
Next k
Sht.Columns.AutoFit 'autofit columns on last data sheet
With Sheets("Poller")
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("B2"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("A:C")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
.Range("D1") = "> 2s"
.Range("E1") = "> 10s"
.Range("F1") = "Headroom"
.Range("G1") = "Count"
For c = 2 To .Range("A1").End(xlDown).Row
If .Range("C" & c) > 2000 Then
.Range("D" & c) = 1
Else
.Range("D" & c) = 0
End If
If .Range("C" & c) > 10000 Then
.Range("E" & c) = 1
Else
.Range("E" & c) = 0
End If
.Range("F" & c) = "=(2000-C" & c & ")/2000"
.Range("G" & c) = c - 1
Next c
Dim l As Integer
l = .Range("B1:B65536").Find("DYNAMIC").Row
Cells(l, 1).EntireRow.Insert
MsgBox "Getting Poller Calculations " & l
Dim lastRow As Integer
lastRow = .Range("A1").End(xlDown).Offset(1).Row
Dim endRow As Integer
endRow = .Range("A65536").End(xlUp).Row
Dim lRow As Integer
lRow = .Range("A1").End(xlDown).Row
'MsgBox "Lastrow = " & lastRow & ", lRow = " & lRow & ", endRow = " & endRow
.Range("D" & lastRow) = "=SUM(D2:D" & lRow & ")"
.Range("E" & lastRow) = "=SUM(E2:E" & lRow & ")"
.Range("F" & lastRow) = "=AVERAGE(F2:F" & lRow & ")"
.Range("D" & endRow + 1) = "=SUM(D" & lastRow + 1 & ":D" & endRow & ")"
.Range("E" & endRow + 1) = "=SUM(E" & lastRow + 1 & ":E" & endRow & ")"
.Range("F" & endRow + 1) = "=AVERAGE(F" & lastRow + 1 & ":F" & endRow & ")"
Sheets("Summary").Range("B9").Value = .Range("F" & endRow).Value
Sheets("Summary").Range("B10").Value = .Range("F" & lastRow).Value
Sheets("Summary").Range("B11").Value = .Range("D" & endRow).Value
Sheets("Summary").Range("B12").Value = .Range("E" & endRow).Value
Sheets("Summary").Range("B13").Value = .Range("D" & lastRow).Value
Sheets("Summary").Range("B14").Value = .Range("E" & lastRow).Value
End With
Set tWB = Nothing
Set tWS = Nothing
'Set WBM = Nothing
Set Sht = Nothing
Set uRange = Nothing
End Sub
'--------
Sub Notifications(Path As String, Sht, Dat, WBM)
Dim tWB As Workbook 'temporary workbook (each in directory)
Dim tWS As Worksheet 'temporary worksheet variable
Dim FileName As String 'temporary filename string variable
Dim sPath As String
Dim uRange As Range 'usedrange for each temporary sheet
Dim RowCount As Long 'Rows used on master sheet
Dim tDate As Date
Dim c As Integer
For i = 1 To 7 'Loop through 7 days
FileName = Dir(Path & Dat & "-notification.csv", vbNormal)
Do Until FileName = "" 'loop until all files have been parsed
If Path <> ThisWorkbook.Path Or FileName <> ThisWorkbook.Name Then
Set tWB = Workbooks.Open(FileName:=Path & FileName) 'open file, set to tWB variable
For Each tWS In tWB.Worksheets 'loop through each sheet
Set uRange = tWS.Range("A2", tWS.Cells(tWS.UsedRange.Row + tWS.UsedRange.Rows _
.Count - 1, tWS.UsedRange.Column + tWS.UsedRange.Columns.Count - 1)) 'set used range
If RowCount + uRange.Rows.Count > 65536 Then 'if the used range wont fit on the sheet
Sht.Columns.AutoFit 'autofit mostly-used worksheet's columns
Set Sht = WBM.Sheets.Add(After:=Sht) 'add a new sheet that will accommodate data
RowCount = 0 'reset RowCount variable
End If
If RowCount = 0 Then 'if working with a new sheet
Sht.Range("A1", Sht.Cells(1, uRange.Columns.Count)).Value = _
tWS.Range("A1", tWS.Cells(1, uRange.Columns.Count)).Value 'copy headers from tWS
RowCount = 1 'add one to rowcount
End If
Sht.Range("A" & RowCount + 1).Resize(uRange.Rows.Count, uRange.Columns.Count).Value _
= uRange.Value 'move data from temp sheet to data sheet
RowCount = RowCount + uRange.Rows.Count 'increase rowcount accordingly
Next
tDate = DateValue(Dat)
tDate = DateAdd("d", -1, tDate)
Dat = Format(tDate, "dd-mm-yyyy")
tWB.Close False 'close temporary workbook without saving
End If
FileName = Dir() 'set next file's name to FileName variable
Loop
Next i
Sht.Columns.AutoFit 'autofit columns on last data sheet
With Sheets("Notifications")
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("B2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("A:C")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
.Range("D1") = "Minutes"
.Range("E1") = "10 Mins"
.Range("F1") = "30 Mins"
.Range("G1") = "Count"
For c = 2 To .Range("A1").End(xlDown).Row
.Range("D" & c) = "=C" & c & "/60000"
If .Range("D" & c) > 10 Then
.Range("E" & c) = 1
Else
.Range("E" & c) = 0
End If
If .Range("D" & c) > 30 Then
.Range("F" & c) = 1
Else
.Range("F" & c) = 0
End If
.Range("G" & c) = c - 1
Next c
Dim l As Integer
l = .Range("B1:B65536").Find("FAX").Row
Cells(l, 1).EntireRow.Insert
MsgBox "Getting Notification Calculations " & l
Dim lastRow As Integer
lastRow = .Range("A1").End(xlDown).Offset(1).Row
Dim endRow As Integer
endRow = .Range("A65536").End(xlUp).Row
Dim lRow As Integer
lRow = .Range("A1").End(xlDown).Row
'MsgBox "Lastrow = " & lastRow & ", lRow = " & lRow & ", endRow = " & endRow
.Range("D" & lastRow) = "=AVERAGE(D2:D" & lRow & ")*60"
.Range("E" & lastRow) = "=SUM(E2:E" & lRow & ")"
.Range("F" & lastRow) = "=SUM(F2:F" & lRow & ")"
.Range("D" & endRow + 1) = "=AVERAGE(D" & lastRow + 1 & ":D" & endRow & ")*60"
.Range("E" & endRow + 1) = "=SUM(E" & lastRow + 1 & ":E" & endRow & ")"
.Range("F" & endRow + 1) = "=SUM(F" & lastRow + 1 & ":F" & endRow & ")"
Sheets("Summary").Range("B16").Value = .Range("D" & lastRow).Value
Sheets("Summary").Range("B17").Value = .Range("E" & lastRow).Value
Sheets("Summary").Range("B18").Value = .Range("F" & lastRow).Value
Sheets("Summary").Range("B19").Value = .Range("D" & endRow + 1).Value
Sheets("Summary").Range("B20").Value = .Range("E" & endRow + 1).Value
Sheets("Summary").Range("B21").Value = .Range("F" & endRow + 1).Value
End With
Set tWB = Nothing
Set tWS = Nothing
'Set WBM = Nothing
Set Sht = Nothing
Set uRange = Nothing
End SubThanks in advance
