Select method of Range class failed

catharsis50 · Feb 14, 2012

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

shg · Feb 22, 2012

Did you know that you can define names with worksheet scope, so that a range "bob" could exist on every sheet?

catharsis50 · Feb 22, 2012

I thought that's what I was doing, but I guess I'm doing it wrong. What would the format I would need to write the range variable definitions in look like compared to what I have from the script I've provided?

Thank you!

catharsis50 · Feb 22, 2012

If I'm trying to define these dynamic ranges for all three workbooks what would I do differently in defining it and how would the syntax change in referencing the range?

Code:

Dim LastRow As Long, LastRow1 As Long
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
or

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)

and referring to them previously with

Code:

 Range("AL2").AutoFill Destination:=Range("AL2:AL" & LastRow)

of

Code:

kdselect.copy

shg · Feb 22, 2012

I'm trying to define these dynamic ranges for all three workbooks ...

Are the ranges supposed to cover the exact same cells in all three workbooks, or is the range to be calculated for each workbook?

What are the three workbook names, or is it alway the three workbooks that are open?

Within each workbook, is the range always on the sheet named "Karl Dashboard"?

Why do End three times in this? What is the data arrangment that makes it necessary?

Code:

Set kdash = Sheets("Karl Dashboard").Range("S3").End(xlDown).End(xlDown).End(xlDown).End(xlDown)

catharsis50 · Feb 22, 2012

I have many ranges defined that are the same range within different workbooks but the bottom parameter is dynamic using (xldown), all else is the same across all three workbooks. The workbooks are called "Copy of Q1 2012 QBR Metrics Report Template test", "Q4 2011 QBR Metrics Report Template" and "Q3 QBR Metrics Report". All three workbooks have the same worksheet names as they were at one point the current quarter workbook, they all have a "Karl Dashboard" tab that require the same "kdselecet" range to be copied. The reason that (xldown) is used in succession like that is that it is grabbing a table with different sub total, total and the body of the table where the number of rows differs pending what data is brought in during the refresh.

Thanks.

shg · Feb 22, 2012

Code:

    Const sName     As String = "kdselect"
    Dim wkb         As Workbook
    Dim wks         As Worksheet
 
    For Each wkb In Workbooks
        Set wks = wkb.Worksheets("Karl Dashboard")
        wkb.Names.Add Name:=sName, _
                      RefersTo:=wks.Range("B3", wks.Range("S3").End(xlDown).End(xlDown).End(xlDown).End(xlDown))
    Next wkb
 
    ' then if you want to copy
    Workbooks("Q4 2011 QBR Metrics Report Template.xlsm").Names(sName).RefersToRange.Copy _
            Destination:=Workbooks("Q3 QBR Metrics Report").Names(sName).RefersToRange(1)

catharsis50 · Feb 22, 2012

Wow, thank you. Quick question before I implement this for testing. When you say sName is that something that will change with each range, or does that remain constant within the commands. The other part I had a question about was "referstorange" is that where I'd specify the defined range, so in this example

Code:

 Workbooks("Q4 2011 QBR Metrics Report Template.xlsm").Names(sName).kdselect.Copy _

'is this where kdselect going to get pasted or what does the destination portion do?            

Destination:=Workbooks("Q3 QBR Metrics Report").Names(sName).RefersToRange(1)

'what is "referstorange(1) if it's not the destination for kdselect to get pasted?

thanks

shg · Feb 22, 2012

'what is "referstorange(1)

If the size of the ranges can be different in each workbook, then you cannot paste the range from one workbook to the range in another. Instead, you paste it to the first cell in the destination range.

catharsis50 · Feb 22, 2012

Would there have to be a paste command at the end of that then,
like this?

Code:

Workbooks("Q4 2011 QBR Metrics Report Template.xlsm").Names(sName).RefersToRange.Copy _
            Destination:=Workbooks("Q3 QBR Metrics Report").Names(sName).RefersToRange(1).paste

catharsis50 · Feb 22, 2012

Would there need to a similar setup for the other example I've used throughout this macro.

Code:

Dim LastRow As Long
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row

Where it's getting used often in cases like these.

Code:

Range("AL2").AutoFill Destination:=Range("AL2:AL" & LastRow)

If so what would have to change in this type of situation to be used across the three workbooks?

Thanks!

Select method of Range class failed

catharsis50

New Member

shg

MrExcel MVP

Excel Facts

catharsis50

New Member

catharsis50

New Member

shg

MrExcel MVP

catharsis50

New Member

shg

MrExcel MVP

catharsis50

New Member

shg

MrExcel MVP

catharsis50

New Member

catharsis50

New Member

Similar threads

Forum statistics

Share this page

Select method of Range class failed

New Member

MrExcel MVP

Excel Facts

New Member

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock