Public Filename, GCOT, FCCT, Status, Sheetname, Director1, Director
Sub Macro1()
Dim file1
MsgBox ("Open the GCOT automated report")
file1 = Application.GetOpenFilename()
Set owb = Application.Workbooks.Open(file1)
strString = Split(file1, "\")
'UBound - Returns the highest available subscript for the indicated dimension of an array.
For i = 0 To UBound(strString) - 1
' strNewPath = strNewPath & strString(i) & "\"
Next
Filename = strString(i)
MsgBox ("File name is: " & Filename)
Workbooks(Filename).Sheets(2).Activate
GCOT = InputBox("Enter the column number for LOB_Tier1") 'getting values from user. Value for the field should be number
FCCT = InputBox("Enter the column number for LOB_Tier2")
Status = InputBox("Enter Idea_Status column number")
Sheetname = ActiveWorkbook.Sheets(2).Name 'InputBox("Enter the main Sheet name")
Director1 = InputBox("Enter 'Final Director Name' column number")
For i = 2 To 12
Workbooks(Filename).Sheets("Directorlist").Activate
'throwing error unable to extract data from the directorlist
Workbooks(Filename).Sheets("Directorlist").Cells(i, 3).Activate
Director = ActiveCell.Value
'Set Director = ActiveSheet.Cells(i, 0).Value
Call directordata(Filename, Sheetname, Director)
Next
End Sub
Function directordata(Filename, Sheetname, Director)
'//Sheila Wilson
On Error Resume Next 'to check whether the Sheetname is matching with the name in the report
Workbooks(Filename).Sheets(Sheetname).Activate
If (Err.Number) Then
MsgBox Sheename & " is not matching with name in the report"
End If
Workbooks(Filename).Sheets(Sheetname).Rows("5:5").Select
If (Director <> "Jessica G Adams") Then
Workbooks(Filename).Sheets(Sheetname).Range("$A$5:$W$5").AutoFilter Field:=GCOT, Criteria1:= _
"GCOT"
Workbooks(Filename).Sheets(Sheetname).Range("$A$5:$W$5").AutoFilter Field:=FCCT, Criteria1:= _
"FCCT"
End If
Workbooks(Filename).Sheets(Sheetname).Range("$A$5:$W$5").AutoFilter Field:=Status, Criteria1:=Array("Approved", "Draft", "Future Pipeline", "In Progress", _
"Pending Actuals", "Ready for Finance Review", "Submit for Approval"), Operator _
:=xlFilterValues
'Director
Workbooks(Filename).Sheets(Sheetname).Range("$A$5:$W$5").AutoFilter Field:=Director1, Criteria1:=Director
On Error Resume Next
Workbooks(Filename).Sheets(Director).Activate
If (Err.Number) Then
MsgBox "Sheet name for " & Director & "does not match"
End If
Workbooks(Filename).Sheets(Director).Range("B25").Select
Workbooks(Filename).Sheets(Director).Range(Selection, Selection.End(xlDown)).Select
Workbooks(Filename).Sheets(Director).Range(Selection, Selection.End(xlToRight)).Select
Selection.Clear
Workbooks(Filename).Sheets(Sheetname).Activate
Workbooks(Filename).Sheets(Sheetname).Range("A5").Select
Workbooks(Filename).Sheets(Sheetname).Range(Selection, Selection.End(xlDown)).Select
Workbooks(Filename).Sheets(Sheetname).Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Workbooks(Filename).Sheets(Director).Activate
Workbooks(Filename).Sheets(Director).Range("B25").Select
Workbooks(Filename).Sheets(Director).Paste
Workbooks(Filename).Sheets(Director).Range("B25").Select
Workbooks(Filename).Sheets(Director).Range(Selection, Selection.End(xlDown)).Select
Workbooks(Filename).Sheets(Director).Range(Selection, Selection.End(xlToRight)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.RowHeight = 15
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Deleting unwanted columns
Workbooks(Filename).Sheets(Director).Range("B25").Select
Workbooks(Filename).Sheets(Director).Range(Selection, Selection.End(xlDown)).Select
Workbooks(Filename).Sheets(Director).Range(Selection, Selection.End(xlToRight)).Select
Selection.Columns("G:I").Delete
Selection.Columns("G:H").Delete
Selection.Columns("L:Q").Delete
Selection.Columns("N:AR").Delete
Selection.Columns("O:AA").Delete 'Q 2015 saves deleted
Selection.Columns("S:AK").Delete
Selection.Columns("T:X").Delete
' Arranging the Automation type in descending order
Workbooks(Filename).Sheets(Director).Range("N25").Select
Rows2 = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
Workbooks(Filename).Sheets(Director).Sort.SortFields.Clear ' will clear the existing sorting
Workbooks(Filename).Sheets(Director).Sort.SortFields.Add Key:=Range("O25"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal 'xlAscending 'take a column and sort order
With Workbooks(Filename).Sheets(Director).Sort ' parameters of sorting include selecting table(Range), header, apply
' .SetRange Range("E15:G21")
.SetRange Range("B26:T" & Rows2)
.Header = xlGuess 'xlNo ' xlGuess or xlNo anyone could be used
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Workbooks(Filename).Sheets(Sheetname).Activate
Workbooks(Filename).Sheets(Sheetname).Range("$A$5:$W$5").AutoFilter
End Function
