Sub Report()
Application.ScreenUpdating = False
Dim Src, Dst As Workbook
Dim c As Range
Dim lrow, i As Integer
Dim SrcName, arr(9), brr(10) As String
Set Dst = ActiveWorkbook
SrcName = GetFile("C:\")
If SrcName = "" Then
MsgBox "Canceled by user request!", vbInformation
Exit Sub
End If
Workbooks.Open SrcName
Set Src = ActiveWorkbook
arr(0) = "WIP"
arr(1) = "With Assignee"
arr(2) = "With CCB Approver"
arr(3) = "With CCB Approver After Patch Initiation"
arr(4) = "With Reviewer For Clarification"
arr(5) = "Initiation"
arr(6) = "With Support Team for Ownership"
arr(7) = "With Release Manager Team For RCD Approval"
arr(8) = "With Reviewer For Patch"
arr(9) = "With Reviewer For Closure"
brr(0) = "WIP"
brr(1) = "With Assignee"
brr(2) = "With Requestor For Clarification"
brr(3) = "With CCB Approver"
brr(4) = "With CCB Approver After Patch Initiation"
brr(5) = "With Reviewer For Clarification"
brr(6) = "Initiation"
brr(7) = "With Support Team for Ownership"
brr(8) = "With Release Manager Team For RCD Approval"
brr(9) = "With Reviewer For Patch"
brr(10) = "With Reviewer For Closure"
Src.Sheets(1).UsedRange.Copy Dst.Sheets(1).Cells(1, 1)
Src.Close False
Dst.Activate
lrow = Sheets(1).UsedRange.Rows.Count
Sheets(1).Range("Q:T,W:AD").Delete
Sheets(1).Columns("M:M").Insert Shift:=xlToRight
Sheets(1).Range("M2").Formula = "=N2-O2"
Sheets(1).Range("M2:M" & lrow).FillDown
Sheets(1).Range("M1").Value = "SLA HRS LEFT"
For i = 2 To Sheets.Count
With Sheets(1).Rows(1)
.Copy Sheets(i).Rows(1)
End With
Next i
For Each c In Sheets(1).Range("E2:E" & lrow)
If InStr(c, "FINCRM 10.3.") = 0 And InStr(c.Offset(, -3), "ITL") = 0 And InStr(c.Offset(, -3), "URALSIB") = 0 And InStr(c.Offset(, 14), "CUSTOMIZATION_ISSUE") = 0 And InStr(c.Offset(, 14), "SIT_CUSTOMISATION") = 0 And InStr(c.Offset(, 14), "CUSTOMISATION REQUEST") = 0 Then
c.EntireRow.Copy Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next c
lrow = Sheets(2).UsedRange.Rows.Count
For Each c In Sheets(2).Range("R2:R" & lrow)
If c = "PRODUCTION" Then
c.EntireRow.Copy Sheets(3).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next c
For Each c In Sheets(2).Range("R2:R" & lrow)
If c <> "PRODUCTION" Then
c.EntireRow.Copy Sheets(4).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next c
lrow = Sheets(3).UsedRange.Rows.Count
For Each c In Sheets(3).Range("M2:M" & lrow)
If c > 0 And c <= 120 And IsInArray(c.Offset(, -2), arr) = True Then
c.EntireRow.Copy Sheets(5).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next c
Sheets(1).Rows(1).Copy Sheets(5).Cells(Rows.Count, 1).End(xlUp).Offset(3)
For Each c In Sheets(3).Range("M2:M" & lrow)
If c > 0 And c <= 120 And c.Offset(, -2) = "With Requestor For Clarification" Then
c.EntireRow.Copy Sheets(5).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next c
lrow = Sheets(4).UsedRange.Rows.Count
For Each c In Sheets(4).Range("M2:M" & lrow)
If c > 0 And c <= 120 And IsInArray(c.Offset(, -2), arr) = True Then
c.EntireRow.Copy Sheets(6).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next c
Sheets(1).Rows(1).Copy Sheets(6).Cells(Rows.Count, 1).End(xlUp).Offset(3)
For Each c In Sheets(4).Range("M2:M" & lrow)
If c > 0 And c <= 120 And c.Offset(, -2) = "With Requestor For Clarification" Then
c.EntireRow.Copy Sheets(6).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next c
lrow = Sheets(3).UsedRange.Rows.Count
For Each c In Sheets(3).Range("M2:M" & lrow)
If c > 0 And c <= 48 And IsInArray(c.Offset(, -2), arr) = True Then
c.EntireRow.Copy Sheets(7).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next c
Sheets(1).Rows(1).Copy Sheets(7).Cells(Rows.Count, 1).End(xlUp).Offset(3)
For Each c In Sheets(3).Range("M2:M" & lrow)
If c > 0 And c <= 48 And c.Offset(, -2) = "With Requestor For Clarification" Then
c.EntireRow.Copy Sheets(7).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next c
lrow = Sheets(4).UsedRange.Rows.Count
For Each c In Sheets(4).Range("M2:M" & lrow)
If c > 0 And c <= 48 And IsInArray(c.Offset(, -2), arr) = True Then
c.EntireRow.Copy Sheets(8).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next c
Sheets(1).Rows(1).Copy Sheets(8).Cells(Rows.Count, 1).End(xlUp).Offset(3)
For Each c In Sheets(4).Range("M2:M" & lrow)
If c > 0 And c <= 48 And c.Offset(, -2) = "With Requestor For Clarification" Then
c.EntireRow.Copy Sheets(8).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next c
lrow = Sheets(3).UsedRange.Rows.Count
For Each c In Sheets(3).Range("K2:K" & lrow)
If c = "With CCB Approver" Then
c.EntireRow.Copy Sheets(9).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next c
lrow = Sheets(4).UsedRange.Rows.Count
For Each c In Sheets(4).Range("K2:K" & lrow)
If c = "With CCB Approver" Then
c.EntireRow.Copy Sheets(10).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next c
lrow = Sheets(3).UsedRange.Rows.Count
For Each c In Sheets(3).Range("M2:M" & lrow)
If c > 0 And c <= 24 And IsInArray(c.Offset(, -2), brr) = True Then
c.EntireRow.Copy Sheets(11).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next c
Sheets(1).Rows(1).Copy Sheets(11).Cells(Rows.Count, 1).End(xlUp).Offset(3)
lrow = Sheets(4).UsedRange.Rows.Count
For Each c In Sheets(4).Range("M2:M" & lrow)
If c > 0 And c <= 24 And IsInArray(c.Offset(, -2), brr) = True Then
c.EntireRow.Copy Sheets(11).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next c
lrow = Sheets(3).UsedRange.Rows.Count
For Each c In Sheets(3).Range("Q2:Q" & lrow)
If c = "Not Met" Then
c.EntireRow.Copy Sheets(12).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next c
lrow = Sheets(4).UsedRange.Rows.Count
For Each c In Sheets(4).Range("Q2:Q" & lrow)
If c = "Not Met" Then
c.EntireRow.Copy Sheets(13).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next c
For Each c In Sheets(11).Columns("M:M").SpecialCells(xlCellTypeFormulas)
c.Formula = "=O2-N2"
Next c
MsgBox "Report complete!", vbInformation
Application.ScreenUpdating = True
End Sub
Private Function IsInArray(valToBeFound As Variant, arr As Variant) As Boolean
Dim element As Variant
On Error GoTo IsInArrayError: 'array is empty
For Each element In arr
If element = valToBeFound Then
IsInArray = True
Exit Function
End If
Next element
Exit Function
IsInArrayError:
On Error GoTo 0
IsInArray = False
End Function
Function GetFile(strPath As String) As String
Dim File As FileDialog
Dim sItem As String
Set File = Application.FileDialog(msoFileDialogFilePicker)
With File
.Title = "Select RAW DATA file"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel files only", "*.xls; *.xlsx, *.xlsm"
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFile = sItem
Set File = Nothing
End Function