Sub My_Macro()Dim rng1
Dim rng2
Set rng1 = Worksheets("Score Card").Range("H10:M31")
Set rng2 = Worksheets("Score Card").Range("H35:M35")
On Error Resume Next
Application.ScreenUpdating = False
If Intersect(ActiveCell, Union(rng1, rng2)) Is Nothing Then
MsgBox "Drill Down in not available for this field, please select again.", vbCritical + vbOKOnly
Exit Sub
End If
'Team
On Error Resume Next
Worksheets("Query").Range("C2").Value = Worksheets("Score Card").Range("D2").Value
If Range("H3").Value = True Then
Worksheets("Query").Range("D2").Value = Worksheets("Score Card").Range("D4").Value
Else
Worksheets("Query").Range("D2").Value = ""
End If
'Month
On Error Resume Next
Worksheets("Query").Range("C3").Value = Worksheets("Score Card").Range("J2").Value
'Stage
On Error Resume Next
Worksheets("Query").Range("C4").Value = Cells(9, ActiveCell.Column).Value
'Product
On Error Resume Next
Worksheets("Query").Range("C5").Value = Cells(ActiveCell.Row, 6)
Call Macro2
Worksheets("Drill Down").Activate
Call addhyperlink
Range("A1").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub Macro2()
Dim Fieldcheck
Dim ldate As String
Dim i
Dim lastRow
On Error Resume Next
Application.Calculation = xlCalculationManual
Worksheets("Drill Down").Activate
ActiveSheet.ShowAllData
'If Worksheets("Query").Range("D2").Value = "" Then
'ActiveSheet.ShowAllData
'End If
lastRow = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Range("A2:AC" & lastRow).ClearContents
i = 3
For i = 3 To 6
On Error Resume Next
If Worksheets("Query").Cells(11, i).Value = "" Then
GoTo NextI
End If
'Team/Region
'vlookup for column number
On Error Resume Next
Fieldcheck = Application.WorksheetFunction.VLookup(Worksheets("Query").Range("B10").Value, Worksheets("Query").Range("AC1:AD29"), 2, 0)
Worksheets("Pipeline").Activate
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
On Error Resume Next
If Worksheets("Query").Range("C10").Value = "EMEA TOTAL" Then
GoTo Product
Else
ActiveSheet.Range("$A$1:$AC$5000").AutoFilter Field:=Fieldcheck, Criteria1:= _
Application.WorksheetFunction.VLookup(Worksheets("Query").Range("C10").Value, Worksheets("Team Table").Range("G1:H27"), 2, 0), Operator:=xlFilterValues
Debug.Print Application.WorksheetFunction.VLookup(Worksheets("Query").Range("C10").Value, Worksheets("Team Table").Range("G1:H27"), 2, 0)
End If
Product:
Worksheets("Query").Activate
'Product Group
'vlookup for column number
On Error Resume Next
Fieldcheck = Application.WorksheetFunction.VLookup(Worksheets("Query").Range("B13").Value, Worksheets("Query").Range("AC1:AD29"), 2, 0)
Worksheets("Pipeline").Activate
On Error Resume Next
ActiveSheet.Range("$A$1:$AC$5000").AutoFilter Field:=Fieldcheck, Criteria1:= _
Worksheets("Query").Range("C13").Value, Operator:=xlFilterValues
Worksheets("Query").Activate
'Close Month
'vlookup for column number
On Error Resume Next
Fieldcheck = Application.WorksheetFunction.VLookup(Worksheets("Query").Range("B11").Value, Worksheets("Query").Range("AC1:AD29"), 2, 0)
If Worksheets("Query").Range("C4").Value = "120+ DAYS" Then
ldate = DateSerial(Year(Worksheets("Query").Cells(11, i).Value), Day(Worksheets("Query").Cells(11, i).Value), Month(Worksheets("Query").Cells(11, i).Value))
Debug.Print ldate
Debug.Print Worksheets("Query").Cells(11, i).Value
Worksheets("Pipeline").Activate
On Error Resume Next
ActiveSheet.Range("$A$1:$AC$5000").AutoFilter Field:=Fieldcheck, Criteria1:= _
">=" & ldate, Operator:=xlFilterValues
Else
ldate = DateSerial(Year(Worksheets("Query").Cells(11, i).Value), Month(Worksheets("Query").Cells(11, i).Value), Day(Worksheets("Query").Cells(11, i).Value))
Worksheets("Pipeline").Activate
On Error Resume Next
ActiveSheet.Range("$A$1:$AC$5000").AutoFilter Field:=Fieldcheck, Criteria1:= _
ldate, Operator:=xlFilterValues
End If
Worksheets("Query").Activate
'Stage
'vlookup for column number
On Error Resume Next
Fieldcheck = Application.WorksheetFunction.VLookup(Worksheets("Query").Range("B12").Value, Worksheets("Query").Range("AC1:AD29"), 2, 0)
Worksheets("Pipeline").Activate
On Error Resume Next
ActiveSheet.Range("$A$1:$AC$5000").AutoFilter Field:=Fieldcheck, Criteria1:= _
Worksheets("Query").Cells(12, i).Value, Operator:=xlFilterValues
Worksheets("Query").Activate
'Copy Data
Call MergeData
NextI:
Next
If Worksheets("Query").Range("D2").Value = "" Then
Else
Worksheets("Drill Down").Activate
ActiveSheet.Range("$A$1:$AC$5000").AutoFilter Field:=6, Criteria1:= _
Worksheets("Query").Range("D2").Value, Operator:=xlFilterValues
End If
Worksheets("Pipeline").AutoFilterMode = False
End Sub
Sub MergeData()
Dim lastrowCIQ As Long
Dim lastrowpipe As Long
Dim ciq As Worksheet
Dim pipe As Worksheet
Set ciq = Worksheets("Drill Down")
Set pipe = Worksheets("Pipeline")
On Error Resume Next
lastrowCIQ = ciq.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
lastrowpipe = pipe.Cells(Rows.Count, 1).End(xlUp).Row
If lastrowpipe = 1 Then
Exit Sub
End If
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
ciq.Activate
'Team
pipe.Range("B2:B" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Opportunity Name
pipe.Range("E2:E" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Company/Account Name
pipe.Range("F2:F" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 3).Select
Selection.PasteSpecial Paste:=xlPasteValues
'ACV
pipe.Range("H2:H" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 4).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Product Family
pipe.Range("L2:L" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 5).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Owner
pipe.Range("O2:O" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 6).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Close Date
pipe.Range("R2:R" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 7).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Stage
pipe.Range("T2:T" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 8).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Confidence
pipe.Range("Z2:Z" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 9).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Vish Cat
pipe.Range("AA2:AA" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 10).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Vish Sales Manager
pipe.Range("AB2:AB" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 11).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Quarter
pipe.Range("AC2:AC" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 12).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Opp ID
pipe.Range("A2:A" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 13).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Created Date
pipe.Range("C2:C" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 14).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Lead Source
pipe.Range("D2:D" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 15).Select
Selection.PasteSpecial Paste:=xlPasteValues
'ACV Currency
pipe.Range("I2:I" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 16).Select
Selection.PasteSpecial Paste:=xlPasteValues
'ACV
pipe.Range("J2:J" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 17).Select
Selection.PasteSpecial Paste:=xlPasteValues
'ACV Currency USD
pipe.Range("G2:G" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 18).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Product Name
pipe.Range("K2:K" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 19).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Product Platform
pipe.Range("M2:M" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 20).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Primary Country
pipe.Range("N2:N" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 21).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Users
pipe.Range("P2:P" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 22).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Entitlements
pipe.Range("Q2:Q" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 23).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Close Month
pipe.Range("S2:S" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 24).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Modified Date
pipe.Range("U2:U" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 25).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Stage Duration
pipe.Range("V2:V" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 26).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Segment
pipe.Range("W2:W" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 27).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Group
pipe.Range("X2:X" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 28).Select
Selection.PasteSpecial Paste:=xlPasteValues
'Specialty
pipe.Range("Y2:Y" & lastrowpipe).Copy
ciq.Cells(lastrowCIQ, 29).Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.EnableEvents = True
End Sub