Select method of Range class failed

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
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
If WCselect is not on the active worksheet, then you can use

Code:
Application.Goto WCselect

More generally, though, you can replace this

Code:
WCselect.Select
Selection.Copy
Sheets("Deduped Lead Contact Data").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
with
Code:
    WCselect.Copy
    Worksheets("Deduped Lead Contact Data").Range("A1").PasteSpecial Paste:=xlPasteValues
 
Upvote 0
Thanks for the reply, I will test this sometime today/tomorrow and let you know if it works out. Do you have any ideas as to why it would work on the first part of the code the balk up on the second sheet?
 
Upvote 0
Ok, it worked great. I am now getting an 1004: Application defined or object defined error on the third section. Another puzzling error as it executed fine in the previous two sections.

Where I'm getting the error.
Code:
''--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
<big><b>Selection.RemoveDuplicates Columns:=4, Header:=xlYes</big></b>

Thank you!
 
Upvote 0
Why not specify the range rather than using Selection?
 
Upvote 0
I am running into an issue with my defined ranges. Above you had mentioned using application.goto "range" if the range was not on the active worksheet. I am trying to use this range:
Code:
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)
on each of the three workbooks. My problem is that when trying to select that range on the second workbook it is selecting the range from the first workbook. I tried using
Code:
Workbooks("Q4 2011 QBR Metrics Report Template.xlsm").Activate
to activate the workbook I want, yet it still copies the range from the first workbook. Any suggestions?

Here is the code that's beeing executed and copying the range from the wrong workbook:
Code:
'--Copy and paste Q4 Karl Dashboard to current QBR workbook
Workbooks("Q4 2011 QBR Metrics Report Template.xlsm").Activate
kdselect.Copy
Worksheets("Karl Dashboard").kdselect.Copy
Workbooks("Copy of Q1 2012 QBR Metrics Report Template Test.xlsm").Activate
Sheets("Karl Dashboard").Select
 
Last edited:
Upvote 0
A range refers to a specific set of cells on a specific worksheet -- it doesn't matter what sheet is active when you reference it.

If you want to copy the range of cells on a particular worksheet that has the same address as a named range on a different worksheet

Code:
Worksheets("bob").Range(myRangeOnAnotherSheet.Address).Copy

BTW, in this declaration,

Code:
Dim kdash, kdash1, kdselect As Range

... only kdelect is being declared as a Range; the other two are Variants. You have to specify the data type for each variable.
 
Upvote 0
Ok, so how would the other variables have to be defined to work in the format I have tried to use? If each range will only represent a range on one specific sheet do I need to define them after each workbooks gets opened, or how will it work to have the same range defined but on each of the three workbooks. I'm not sure if you've been able to check out script in it's entirety but the beginning of each section is replicating the same actions. I assumed that the defined ranges would just work on each workbook as they opened, but it's sounding like that is not the case.

I really appreciate all your help, you have been a great resource.
 
Upvote 0
Could you explain in words what you're trying to do?
 
Upvote 0
I'll try...
I have a main workbook which is current quarter data, and two other separate workbooks with the last two quarters data. Theses workbook reports are refreshed via Salesforce.com so the numbers change all the time, even past quarter data as things move through the pipeline.

The core tasks that this macro is performing are the same on each of the three workbooks, applying to the same ranges etc. This is why I was attempting to use the same defined range on each of the three workbooks. After updating and rearranging data on each workbook the macro is supposed to grab a part of a summary to paste into the current quarter workbook. This is where the issue was glaring to me that when trying to copy the define range "kdselect" it was copying it from the first workbook open rather than the active workbook I was trying to grab data from to paste into the current quarter workbook.

The order the workbooks open are Q1 2012, all tasks are performed, Q4 2011, tasks are performed and summary is to be brought to Q1 2012 and the same respectively for Q3 2011.

I'm sure this sounds confusing. Let me know if that helped clarify anything.
 
Upvote 0

Forum statistics

Threads
1,216,093
Messages
6,128,784
Members
449,468
Latest member
AGreen17

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