Select method of Range class failed

C

catharsis50

New Member
Joined
Nov 1, 2011
Messages
46
The below macro is jumping between three sheets, I have read that this can cause the select range class error. I have tried to duplicate the script as suggested however when I do this I receive the error "object doesn't support this property or method". The range I'm selecting is a named range and this is how I tried to re-write it: Sheets("Work1").WCselect.Select. "WCselect" being the named range. Below is the code is it breaks on the second sheet when trying to select the mentioned named range. Thanks in advance for any help.

This formula is in the sheets module
Code: 
Public Function MultiCat( _
        ByRef rRng As Excel.Range, _
        Optional ByVal sDelim As String = "") _
             As String
     Dim rCell As Range
     For Each rCell In rRng
         MultiCat = MultiCat & sDelim & rCell.Text
     Next rCell
     MultiCat = Mid(MultiCat, Len(sDelim) + 1)
  End Function

This is located in Personal.xlsb
Code: 
Function SFDC_Login() As Boolean
End Function
If Not SFDCExcelAddin.IsLoggedIn Then SFDCExcelAddin.Login
SFDC_Login = SFDCExcelAddin.IsLoggedIn
End Function
Function SFDC_RefreshAll() As Boolean
End Function

If SFDC_Login() Then
SFDCExcelAddin.RefreshAll
Else
MsgBox "Login failed", vbExclamation
End If

End Function

Sub QBR_Process()





Dim sPercentage As Single
Dim sStatus As String
Dim LastRow As Long, LastRow1 As Long
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    LastRow1 = LastRow - 1
Dim row1 As Long, row2 As Long, rrow2 As Long, diff As Long
    row1 = Sheets("Deduped Campaign Data").Cells(Rows.Count, "A").End(xlUp).Row
    row2 = Sheets("Dashboard").Cells(Rows.Count, "A").End(xlUp).Row
    rrow2 = row2 - 1
    diff = row1 - rrow2


'SFDCExcelAddin.Login
VBLogin = SFDCExcelAddin.IsLoggedIn() '--check if login was successfull
Application.DisplayAlerts = False
SFDCExcelAddin.RefreshAll
Application.OnTime Now + TimeValue("00:03:00"), "MakeAsyncRequest"
'On Error Resume Next
IncrementalProgress.Show
sPercentage = 10
sStatus = "Reports are Refreshed"
IncrementalProgress.Increment sPercentage, sStatus



'--Transfering last weeks values in Funnel summary
Sheets("Funnel Summary").Select
Range("C12:C19").Select
Selection.Copy
Range("B12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("C2:C10").Select
Selection.Copy
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("C23:C25").Select
Selection.Copy
Range("B23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("B1,B11,B22").Select
    Range("B22").Activate
    Application.CutCopyMode = False
    Selection.FormulaR1C1 = "=TODAY()-14"



'--Copy/Paste, deuplicate, Cmpgn x CmpgnMbrs copy HiddenCampMembID1 - Total Won Opps to Deduped lead sheet
 Dim WC, WC1, WCselect As Range
   Set WC = Sheets("Campaign with Campaign Members").Range("B1").End(xlDown)
   Set WC1 = Sheets("Campaign with Campaign Members").Range("AL1")
   Set WCselect = Range(WC1, WC)

 Sheets("Campaign with Campaign Members").Select
 Range("AL2").AutoFill Destination:=Range("AL2:AL" & LastRow)
 WCselect.Select
 Selection.Copy
 Sheets("Deduped Lead Contact Data").Select
 Range("A1").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 Application.CutCopyMode = False
Range("AQ:CC").Select
Selection.Delete




'--Autofill all formulas for Column AK & AN
ActiveWorkbook.Worksheets("Deduped Lead Contact Data").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Deduped Lead Contact Data").Sort.SortFields.Add Key _
        :=Range("AM1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Deduped Lead Contact Data").Sort
        .SetRange Range("A2:AM" & LastRow)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Selection.RemoveDuplicates Columns:=23, Header:=xlYes

Range("A1:AM" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Range("AO1:AO2"), CopyToRange:=Range("AQ1"), Unique:=False

Range("AQ:BL").Select
Selection.Copy
Sheets("Contact Campaign Members").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Sheets("Deduped Lead Contact Data").Select
Range("BM:BM").Select
Selection.Copy
Sheets("Contact Campaign Members").Select
Range("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Sheets("Deduped Lead Contact Data").Select
Range("BN:CC").Select
Selection.Copy
Sheets("Contact Campaign Members").Select
Range("X1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'--Filling formulas for closed opps w/contacts sheet
Sheets("Closed Opps w Contacts").Select
Range("S2:T2").AutoFill Destination:=Range("S2:T" & LastRow)
ActiveWorkbook.Worksheets("Closed Opps w Contacts").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Closed Opps w Contacts").Sort.SortFields.Add Key _
        :=Range("T1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Closed Opps w Contacts").Sort
        .SetRange Range("A2:T" & LastRow)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Selection.RemoveDuplicates Columns:=5, Header:=xlYes

'--Dedupe Opps in Mktg Influenced Opps based on Opp ID
Dim MKops, MKops1, MKopsselect As Range
   Set MKops = Sheets("Mktg influenced opps").Range("AC1").End(xlDown)
   Set MKops1 = Sheets("Mktg influenced opps").Range("A1")
   Set MKopsselect = Range(MKops, MKops1)
Dim LastRow2 As Long
    LastRow2 = Cells(Rows.Count, "D").End(xlUp).Row

Sheets("Mktg Influenced Opps").Select
Range("AC2").AutoFill Destination:=Range("AC2:AC" & LastRow2)
ActiveWorkbook.Worksheets("Mktg Influenced Opps").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Mktg Influenced Opps").Sort.SortFields.Add Key _
        :=Range("AC1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Mktg Influenced Opps").Sort
        .SetRange Range("A2:AC" & LastRow2)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Selection.RemoveDuplicates Columns:=4, Header:=xlYes


'--Old DedupCampaigns Macro
Dim wwC, wwCith1, wwCselect As Range
   Set wwC = Sheets("Campaign with Campaign Members").Range("AE1").End(xlDown).Offset(0, 2)
   Set wwC1 = Sheets("Campaign with Campaign Members").Range("B1")
   Set wwCselect = Range(wwC1, wwC)
Dim DCD, DCD1, DCDselect As Range
   Set DCD = Sheets("DeDuped Campaign Data").Range("AD1").End(xlDown).Offset(0, 2)
   Set DCD1 = Sheets("DeDuped Campaign Data").Range("A1")
   Set DCDselect = Range(DCD1, DCD)

Sheets("Campaign with Campaign Members").Select
wwCselect.Select
Selection.Copy
Sheets("Deduped Campaign Data").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Selection.RemoveDuplicates Columns:=1, Header:=xlYes



'--Copy data from Campaigns wo Campaign Members
 Dim CWCM, CWCM1, CWCMselect As Range
   Set CWCM = Sheets("Campaigns wo Campaign Members").Range("AD2").End(xlDown).Offset(0, 1)
   Set CWCM1 = Sheets("Campaigns wo Campaign Members").Range("A2")
   Set CWCMselect = Range(CWCM1, CWCM)
 Dim NewDD, NewDD1, NewDDselect As Range
   Set NewDD = Sheets("DeDuped Campaign Data").Range("AD1").End(xlDown).Offset(0, 2)
   Set NewDD1 = Sheets("DeDuped Campaign Data").Range("A1")
   Set NewDDselect = Range(NewDD1, NewDD)

Sheets("Campaigns wo Campaign Members").Select
CWCMselect.Select
Selection.Copy
Sheets("Deduped Campaign Data").Select
Range("A1").End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

ActiveWorkbook.Worksheets("DeDuped Campaign Data").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DeDuped Campaign Data").Sort.SortFields.Add Key:= _
        Range("C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("DeDuped Campaign Data").Sort
        .SetRange Range("A2:AG" & LastRow)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


sPercentage = 30
IncrementalProgress.Increment sPercentage, sStatus

'--Insert New rows into Dashbord table
Sheets("Dashboard").Select
Range("A2").End(xlDown).Select
ActiveCell.Offset(-1, 0).Select
ActiveCell.Offset(1, 0).EntireRow.Resize(diff).Insert
Range("A2:S2").AutoFill Destination:=Range("A2:S" & row1), Type:=xlFillDefault
Range("A2:S" & row1).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone



'--Footer Date/Time stamp
Sheets("date_time").Select
[A5].Select
Range("A2").Select
ActiveCell.FormulaR1C1 = "=multicat(R[2]C:R[4]C)"
Range("A2").Select
Selection.Copy
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Sheets("Dashboard").Select
With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = "&""Calibri,Bold""&24Q4 NA Field Marketing Metrics Rollup"
        .RightHeader = ""
        .LeftFooter = _
        "&""Verdana,Regular""&9Created by Meredith Salget" & Chr(10) & Worksheets("date_time").Cells(2, 2) & Chr(10) & "Primary SFDC Report: https://na5.salesforce.com/00O70000002x3e0"
        .CenterFooter = ""
        .RightFooter = "&""Verdana,Regular""&10&P"
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .Zoom = 80
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With




'SECOND SHEET--Open Q4 QBR Metrics
IncrementalProgress.Show
sPercentage = 30
sStatus = "Opening Q4 QBR Metrics Report Template"
IncrementalProgress.Increment sPercentage, sStatus

Workbooks.Open Filename:="C:\Users\msalget\Documents\Metrics\Bi Weekly Metrics\Q4 2011 QBR Metrics Report Template"
Workbooks("Q4 2011 QBR Metrics Report Template.xlsm").Sheets("Karl Dashboard").Activate

Dim LastRow3 As Long, LastRow4 As Long
    LastRow3 = Cells(Rows.Count, "A").End(xlUp).Row
    LastRow4 = LastRow3 - 1
Dim row3 As Long, row4 As Long, rrow4 As Long, diff1 As Long
    row3 = Sheets("Deduped Campaign Data").Cells(Rows.Count, "A").End(xlUp).Row
    row4 = Sheets("Dashboard").Cells(Rows.Count, "A").End(xlUp).Row
    rrow4 = row4 - 1
    diff1 = row3 - rrow4


'--Refresh SFDC reports
VBLogin = SFDCExcelAddin.IsLoggedIn() '--check if login was successfull
Application.DisplayAlerts = False
SFDCExcelAddin.RefreshAll
Application.OnTime Now + TimeValue("00:03:00"), "MakeAsyncRequest"
'On Error Resume Next


 Dim camp, camp1, campselect As Range
   Set camp = Sheets("Campaign with Campaign Members").Range("AL1").End(xlDown)
   Set camp1 = Sheets("Campaign with Campaign Members").Range("B1")
   Set campselect = Range(camp1, camp)

'--Transfering last weeks values in Funnel summary
Sheets("Funnel Summary").Select
Range("C12:C19").Select
Selection.Copy
Range("B12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("C2:C10").Select
Selection.Copy
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("C23:C25").Select
Selection.Copy
Range("B23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("B1,B11,B22").Select
    Range("B22").Activate
    Application.CutCopyMode = False
    Selection.FormulaR1C1 = "=TODAY()-14"



'--Copy/Paste, deuplicate, Cmpgn x CmpgnMbrs copy HiddenCampMembID1 - Total Won Opps to Deduped lead sheet
 Sheets("Campaign with Campaign Members").Select
 Range("AL2").AutoFill Destination:=Range("AL2:AL" & LastRow)
 <big><b>WCselect.Select</b></big>
 Selection.Copy
 Sheets("Deduped Lead Contact Data").Select
 Range("A1").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 Application.CutCopyMode = False
Range("AQ:CC").Select
Selection.Delete




'--Autofill all formulas for Column AK & AN
ActiveWorkbook.Worksheets("Deduped Lead Contact Data").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Deduped Lead Contact Data").Sort.SortFields.Add Key _
        :=Range("AM1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Deduped Lead Contact Data").Sort
        .SetRange Range("A2:AM" & LastRow)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Selection.RemoveDuplicates Columns:=23, Header:=xlYes

Range("A1:AM" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Range("AO1:AO2"), CopyToRange:=Range("AQ1"), Unique:=False

Range("AQ:BL").Select
Selection.Copy
Sheets("Contact Campaign Members").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Sheets("Deduped Lead Contact Data").Select
Range("BM:BM").Select
Selection.Copy
Sheets("Contact Campaign Members").Select
Range("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Sheets("Deduped Lead Contact Data").Select
Range("BN:CC").Select
Selection.Copy
Sheets("Contact Campaign Members").Select
Range("X1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'--Filling formulas for closed opps w/contacts sheet
Sheets("Closed Opps w Contacts").Select
Range("S2:T2").AutoFill Destination:=Range("S2:T" & LastRow)
ActiveWorkbook.Worksheets("Closed Opps w Contacts").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Closed Opps w Contacts").Sort.SortFields.Add Key _
        :=Range("T1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Closed Opps w Contacts").Sort
        .SetRange Range("A2:T" & LastRow)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Selection.RemoveDuplicates Columns:=5, Header:=xlYes

'--Dedupe Opps in Mktg Influenced Opps based on Opp ID
Sheets("Mktg Influenced Opps").Select
Range("AC2").AutoFill Destination:=Range("AC2:AC" & LastRow2)
ActiveWorkbook.Worksheets("Mktg Influenced Opps").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Mktg Influenced Opps").Sort.SortFields.Add Key _
        :=Range("AC1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Mktg Influenced Opps").Sort
        .SetRange Range("A2:AC" & LastRow2)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Selection.RemoveDuplicates Columns:=4, Header:=xlYes


'--Old DedupCampaigns Macro
Sheets("Campaign with Campaign Members").Select
wwCselect.Select
Selection.Copy
Sheets("Deduped Campaign Data").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Selection.RemoveDuplicates Columns:=1, Header:=xlYes



'--Copy data from Campaigns wo Campaign Members
 Sheets("Campaigns wo Campaign Members").Select
 CWCMselect.Select
 Selection.Copy
 Sheets("Deduped Campaign Data").Select
 Range("A1").End(xlDown).Select
 ActiveCell.Offset(1, 0).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 ActiveWorkbook.Worksheets("DeDuped Campaign Data").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DeDuped Campaign Data").Sort.SortFields.Add Key:= _
        Range("C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("DeDuped Campaign Data").Sort
        .SetRange Range("A2:AG95")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With




'--Insert New rows into Dashbord table

Sheets("Dashboard").Select
Range("A2").End(xlDown).Select
ActiveCell.Offset(-1, 0).Select
ActiveCell.Offset(1, 0).EntireRow.Resize(diff).Insert
Range("A2:S2").AutoFill Destination:=Range("A2:S" & row1), Type:=xlFillDefault
Range("A2:S" & row1).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone


'--Copy and paste Q4 Karl Dashboard to current QBR workbook
Dim kdash, kdash1, kdselect As Range
   Set kdash = Sheets("Karl Dashboard").Range("S3").End(xlDown).End(xlDown).End(xlDown).End(xlDown)
   Set kdash1 = Sheets("Karl Dashboard").Range("B3")
   Set kdselect = Range(kdash1, kdash)
Dim FoundCell As Range
Dim LastCell As Range
Dim FirstAddr As String

Sheets("Karl Dashboard").Select
kdselect.Select
Selection.Copy
Workbooks("Q1 2012 QBR Metrics Report Template Test.xlsm").Activate
Sheets("Karl Dashboard").Select
'
''--Find CPL
With Range("A22:A50")
    Set LastCell = .Cells(.Cells.Count)
End With
Set FoundCell = Range("A22:A50").Find(what:="CPL Program", After:=LastCell)

If Not FoundCell Is Nothing Then
    FirstAddr = FoundCell.Address
End If
Do Until FoundCell Is Nothing
    Debug.Print FoundCell.Address
    Set FoundCell = Range("A22:A50").FindNext(After:=FoundCell)
    If FoundCell.Address = FirstAddr Then
        Exit Do
    End If
Loop
FoundCell.Select
Selection.Offset(o, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'THIRD SHEET--Open Q3 QBR Metrics
IncrementalProgress.Show
sPercentage = 50
sStatus = "Opening Q3 QBR Metrics Report Template"
IncrementalProgress.Increment sPercentage, sStatus

Workbooks.Open Filename:="C:\Users\msalget\Documents\Metrics\Bi Weekly Metrics\Q3 2011 QBR Metrics Report Template"
Workbooks("Q3 QBR Metrics Report Template.xlsm").Sheets("Karl Dashboard").Activate
'
VBLogin = SFDCExcelAddin.IsLoggedIn() '--check if login was successfull
Application.DisplayAlerts = False
SFDCExcelAddin.RefreshAll
Application.OnTime Now + TimeValue("00:03:00"), "MakeAsyncRequest"
'On Error Resume Next



'--Transfering last weeks values in Funnel summary
Sheets("Funnel Summary").Select
Range("C12:C19").Select
Selection.Copy
Range("B12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("C2:C10").Select
Selection.Copy
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("C23:C25").Select
Selection.Copy
Range("B23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("B1,B11,B22").Select
    Range("B22").Activate
    Application.CutCopyMode = False
    Selection.FormulaR1C1 = "=TODAY()-14"



''--Copy/Paste, deuplicate, Cmpgn x CmpgnMbrs copy HiddenCampMembID1 - Total Won Opps to Deduped lead sheet

 Sheets("Campaign with Campaign Members").Select
 Range("AL2").AutoFill Destination:=Range("AL2:AL" & LastRow)
 WCselect.Select
 Selection.Copy
 Sheets("Deduped Lead Contact Data").Select
 Range("A1").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 Application.CutCopyMode = False
Range("AQ:CC").Select
Selection.Delete




''--Autofill all formulas for Column AK & AN
ActiveWorkbook.Worksheets("Deduped Lead Contact Data").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Deduped Lead Contact Data").Sort.SortFields.Add Key _
        :=Range("AM1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Deduped Lead Contact Data").Sort
        .SetRange Range("A2:AM" & LastRow)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Selection.RemoveDuplicates Columns:=23, Header:=xlYes

Range("A1:AM" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Range("AO1:AO2"), CopyToRange:=Range("AQ1"), Unique:=False

Range("AQ:BL").Select
Selection.Copy
Sheets("Contact Campaign Members").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Sheets("Deduped Lead Contact Data").Select
Range("BM:BM").Select
Selection.Copy
Sheets("Contact Campaign Members").Select
Range("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Sheets("Deduped Lead Contact Data").Select
Range("BN:CC").Select
Selection.Copy
Sheets("Contact Campaign Members").Select
Range("X1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

''--Filling formulas for closed opps w/contacts sheet
Sheets("Closed Opps w Contacts").Select
Range("S2:T2").AutoFill Destination:=Range("S2:T" & LastRow)
ActiveWorkbook.Worksheets("Closed Opps w Contacts").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Closed Opps w Contacts").Sort.SortFields.Add Key _
        :=Range("T1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Closed Opps w Contacts").Sort
        .SetRange Range("A2:T" & LastRow)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Selection.RemoveDuplicates Columns:=5, Header:=xlYes

''--Dedupe Opps in Mktg Influenced Opps based on Opp ID
Sheets("Mktg Influenced Opps").Select
Range("AC2").AutoFill Destination:=Range("AC2:AC" & LastRow2)
ActiveWorkbook.Worksheets("Mktg Influenced Opps").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Mktg Influenced Opps").Sort.SortFields.Add Key _
        :=Range("AC1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Mktg Influenced Opps").Sort
        .SetRange Range("A2:AC" & LastRow2)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Selection.RemoveDuplicates Columns:=4, Header:=xlYes


''--Old DedupCampaigns Macro
Sheets("Campaign with Campaign Members").Select
wwCselect.Select
Selection.Copy
Sheets("Deduped Campaign Data").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Selection.RemoveDuplicates Columns:=1, Header:=xlYes



''--Copy data from Campaigns wo Campaign Members
Sheets("Campaigns wo Campaign Members").Select
CWCMselect.Select
Selection.Copy
Sheets("Deduped Campaign Data").Select
Range("A1").End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

ActiveWorkbook.Worksheets("DeDuped Campaign Data").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DeDuped Campaign Data").Sort.SortFields.Add Key:= _
        Range("C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("DeDuped Campaign Data").Sort
        .SetRange Range("A2:AG" & LastRow)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

''--Insert New rows into Dashbord table
Sheets("Dashboard").Select
Range("A2").End(xlDown).Select
ActiveCell.Offset(-1, 0).Select
ActiveCell.Offset(1, 0).EntireRow.Resize(diff).Insert
Range("A2:S2").AutoFill Destination:=Range("A2:S" & row1), Type:=xlFillDefault
Range("A2:S" & row1).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone


'--Copy and paste Q3 Karl Dashboard to current QBR workbook
Sheets("Karl Dashboard").Select
kdselect.Select
Selection.Copy
Workbooks("Q1 2012 QBR Metrics Report Template Test.xlsm").Activate
Sheets("Karl Dashboard").Select

'--Find CPL
With Range("A52:A66")
    Set LastCell = .Cells(.Cells.Count)
End With
Set FoundCell = Range("A51:A66").Find(what:="CPL Program", After:=LastCell)

If Not FoundCell Is Nothing Then
    FirstAddr = FoundCell.Address
End If
Do Until FoundCell Is Nothing
    Debug.Print FoundCell.Address
    Set FoundCell = Range("A52:A66").FindNext(After:=FoundCell)
    If FoundCell.Address = FirstAddr Then
        Exit Do
    End If
Loop
FoundCell.Select
Selection.Offset(o, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'--Copy paste values of Dashboard
Sheets("Dashboard").Select
Range("B1:S" & LastRow).Select
Selection.Copy
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'--Copy Paste values of Karl's Dashboard
Sheets("Karl Dashboard").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'--Hide tabs
ShtsToHide = Array("Mktg Influenced Opps", "Closed Opps w Contacts", "Campaign with Campaign Members", "Campaign wo Campaign Members", _
                "Campaign Summary Data", "Deduped Campaign Data", "Deduped Lead Contact Data", "All Passed Leads", "Contact Campaign Members", "date_time")
For Each ShtName In ShtsToShow
    Worksheets(ShtName).Visible = xlSheetHidden
Next ShtName


'--Save a copy as xlsx
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\msalget\Documents\Metrics\Bi Weekly Metrics\Bi Weekly Metrics" & Format(Date, "mm_dd_yyyy") _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False


sPercentage = 100
IncrementalProgress.Increment sPercentage, sStatus
Unload IncrementalProgress

'--Message Box to do Manual Checks
 MsgBox ("QBR Processing has finished: Proceed with manual checking")

'
'
'
End Sub
 
Sort by date Sort by votes
I just tried to define the range this way and got the "Subscript out of range" error when stepping through the code.
 
Upvote 0

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
You must log in or register to reply here.

Similar threads

C
  • Question
Please help clean up my convoluted VBA code. It seems very redundant and repetitive.
Replies
1
Views
84
myall_blues
myall_blues
C
  • Solved
Please help me clean up my VBA script, I'm having trouble with redundancies
Replies
4
Views
97
CapRavOr
C
P
  • Solved
Counter in For Each loop
Replies
2
Views
212
Possum17
P
P
  • Solved
Need help with macro Dynamic Range??
Replies
6
Views
196
pennbowl
P
A
  • Question
Macro to update list to last row on another sheet copy source from multiple sheets
Replies
0
Views
320
Azamamir
A

Forum statistics

Threads
1,215,467
Messages
6,124,985
Members
449,201
Latest member
Lunzwe73

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top