Runtime Error '91'

C

catharsis50

New Member
Joined
Nov 1, 2011
Messages
46
I am very new to Vb and have got myself into what is a relatively big project for myself. I get the runtime error '91' object varaible or with block variable not set when running this code. I have just pasted the portion that causes the error. Before this portion of the script it is being executed in another workbook, then opening this workbook and continuing to run the script.

This is also causing the Excel Addin for Salesforce.com to not allow the computer to login. Any help is very much appreciated. Let me know if you need any more of the script.

Thanks!


'Workbooks.Open Filename:="C:\Users\msalget\Documents\Metrics\Bi Weekly Metrics\Q3 QBR Metrics Report Template"


'--Activate if not using refresh
'Workbooks("Q3 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

'SFDCExcelAddin.RefreshAll


'Sheets("Campaign with Campaign Members").Select
' WithCselect.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


'--Autofill all formulas for Column AK & AN
'Range("AK2:AN2").AutoFill Destination:=Range("AK2:AN" & LastRow)
'ActiveWorkbook.Worksheets("Deduped Lead Contact Data").AutoFilter.Sort. _
SortFields.Add Key:=Range("AN1"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
'ActiveSheet.Range("$A$1:AN" & LastRow).RemoveDuplicates Columns:=23, Header:= _
xlYes
' With ActiveWorkbook.Worksheets("Deduped Lead Contact Data").AutoFilter.Sort
' .Header = xlYes
' .MatchCase = False
' .Orientation = xlTopToBottom
' .SortMethod = xlPinYin
' .Apply
' End With



'--Old DedupCampaigns Macro
Dim WwithC, Wwith1, Wwithselect As Range
Set WwithC = Sheets("Campaign with Campaign Members").Range("AE1").End(xlDown).Offset(0, 2)
Set WwithC1 = Sheets("Campaign with Campaign Members").Range("B1")
Set WwithCselect = Range(WwithC1, WwithC)
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
'WwithCselect.Select
'Selection.Copy
'Sheets("Deduped Campaign Data").Select
'Range("A1").Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'DCDselect.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
'Range("A1").Select
'NewDDselect.Select
'Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


'sPercentage = 60
'IncrementalProgress.Increment sPercentage, sStatus

'--Dedupe Opps in Mktg Influenced Opps based on Opp ID
Dim MKops, MKops1, MKopsselect As Range
Set MKops = Sheets("Mktg influenced opps").Range("AA1").End(xlDown)
Set MKops1 = Sheets("Mktg influenced opps").Range("A1")
Set MKopsselect = Range(MKops1, MKops)

'Sheets("Mktg Influenced Opps").Select
'MKopsselect.RemoveDuplicates Columns:=4, Header:=xlYes


'--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 Dashboard to Campaign Summary data
Dim CSD, CSD1, CSDselect As Range
Set CSD = Sheets("Campaign Summary Data").Range("S1").End(xlDown)
Set CSD1 = Sheets("Campaign Summary Data").Range("A1")
Set CSDselect = Range(CSD1, CSD)
'Sheets("Dashboard").Select
'Range("A1:S" & LastRow1).Select
'Selection.Copy
'Sheets("Campaign Summary Data").Select
'Range("A1").Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'CSDselect.RemoveDuplicates Columns:=3, Header:=xlYes
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Sort by date Sort by votes
it would be very helpful if you could use code blocks and see my sig below.
 
Upvote 0
I don't get any error when I run the code snippet.
Is there a particular line highlighted when the error occurs?
 
Upvote 0
as this is a snippit, the error could be above with missing end if etc. so we really need to see the whole lot. a good case for intenting!
 
Upvote 0
yeh we were talking about6 it in 'the lounge' a couple of weeks ago. dont know if you saw the thread...
 
Upvote 0
Hopefully this is what you mean when you say code blocks. Here is the entire code. Every thing works fine until the part initially posted and trying to refresh all reports. This also is the part that errors out with runtime error '91' on my co-workers computer.

Thank you for any and all help!

Function SFDC_Login() As Boolean
If Not SFDCExcelAddin.IsLoggedIn Then SFDCExcelAddin.Login
SFDC_Login = SFDCExcelAddin.IsLoggedIn
End Function
Function SFDC_RefreshAll() As Boolean

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
SFDCExcelAddin.RefreshAll
Application.DisplayAlerts = False
'Application.OnTime Now + TimeValue("00:03:00"), "MakeAsyncRequest"
IncrementalProgress.Show
sPercentage = 10
sStatus = "Reports are Refreshed"
IncrementalProgress.Increment sPercentage, sStatus


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

Sheets("Campaign with Campaign Members").Select
WithCselect.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


'--Autofill all formulas for Column AK & AN
Range("AK2:AN2").AutoFill Destination:=Range("AK2:AN" & LastRow)
ActiveWorkbook.Worksheets("Deduped Lead Contact Data").AutoFilter.Sort. _
SortFields.Add Key:=Range("AN1"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
ActiveSheet.Range("$A$1:AN" & LastRow).RemoveDuplicates Columns:=23, Header:= _
xlYes
With ActiveWorkbook.Worksheets("Deduped Lead Contact Data").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With



'--Old DedupCampaigns Macro
Dim WwithC, Wwith1, Wwithselect As Range
Set WwithC = Sheets("Campaign with Campaign Members").Range("AE1").End(xlDown).Offset(0, 2)
Set WwithC1 = Sheets("Campaign with Campaign Members").Range("B1")
Set WwithCselect = Range(WwithC1, WwithC)
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
WwithCselect.Select
Selection.Copy
Sheets("Deduped Campaign Data").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
DCDselect.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
Range("A1").Select
NewDDselect.Select
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


sPercentage = 30
IncrementalProgress.Increment sPercentage, sStatus

'--Dedupe Opps in Mktg Influenced Opps based on Opp ID
Dim MKops, MKops1, MKopsselect As Range
Set MKops = Sheets("Mktg influenced opps").Range("AA1").End(xlDown)
Set MKops1 = Sheets("Mktg influenced opps").Range("A1")
Set MKopsselect = Range(MKops1, MKops)

Sheets("Mktg Influenced Opps").Select
MKopsselect.RemoveDuplicates Columns:=4, Header:=xlYes



'--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 Dashboard to Campaign Summary data
Dim CSD, CSD1, CSDselect As Range
Set CSD = Sheets("Campaign Summary Data").Range("S1").End(xlDown)
Set CSD1 = Sheets("Campaign Summary Data").Range("A1")
Set CSDselect = Range(CSD1, CSD)
Sheets("Dashboard").Select
Range("A1:S" & LastRow1).Select
Selection.Copy
Sheets("Campaign Summary Data").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
CSDselect.RemoveDuplicates Columns:=3, Header:=xlYes

'--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/00O70000002wkBd"
.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




'--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 QBR Metrics Report Template"
Workbooks("Q3 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

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)

Sheets("Campaign with Campaign Members").Select
campselect.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


'--Autofill all formulas for Column AK & AN
Range("AK2:AN2").AutoFill Destination:=Range("AK2:AN" & LastRow)
ActiveWorkbook.Worksheets("Deduped Lead Contact Data").AutoFilter.Sort. _
SortFields.Add Key:=Range("AN1"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
ActiveSheet.Range("$A$1:AN" & LastRow).RemoveDuplicates Columns:=23, Header:= _
xlYes
With ActiveWorkbook.Worksheets("Deduped Lead Contact Data").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With



'--Old DedupCampaigns Macro
Dim wmemb, wmemb1, wmembselect As Range
Set wmemb = Sheets("Campaign with Campaign Members").Range("AE1").End(xlDown).Offset(0, 2)
Set wmemb1 = Sheets("Campaign with Campaign Members").Range("B1")
Set wmembselect = Range(wmemb1, wmemb)
Dim ddupe, ddupe1, ddupeselect As Range
Set ddupe = Sheets("DeDuped Campaign Data").Range("AD1").End(xlDown).Offset(0, 2)
Set ddupe1 = Sheets("DeDuped Campaign Data").Range("A1")
Set ddupeselect = Range(ddupe1, ddupe)

Sheets("Campaign with Campaign Members").Select
wmembselect.Select
Selection.Copy
Sheets("Deduped Campaign Data").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ddupeselect.RemoveDuplicates Columns:=1, Header:=xlYes



'--Copy data from Campaigns wo Campaign Members
Dim wout, wout1, woutselect As Range
Set wout = Sheets("Campaigns wo Campaign Members").Range("AD2").End(xlDown).Offset(0, 1)
Set wout1 = Sheets("Campaigns wo Campaign Members").Range("A2")
Set woutselect = Range(wout1, wout)
Dim DData, DData1, DDataselect As Range
Set DData = Sheets("DeDuped Campaign Data").Range("AD1").End(xlDown).Offset(0, 2)
Set DData1 = Sheets("DeDuped Campaign Data").Range("A1")
Set DDataselect = Range(DData1, DData)

Sheets("Campaigns wo Campaign Members").Select
woutselect.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
Range("A1").Select
DDataselect.Select
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


sPercentage = 60
IncrementalProgress.Increment sPercentage, sStatus

'--Dedupe Opps in Mktg Influenced Opps based on Opp ID
Dim MOps, MOps1, MOpsselect As Range
Set MOps = Sheets("Mktg influenced opps").Range("AA1").End(xlDown)
Set MOps1 = Sheets("Mktg influenced opps").Range("A1")
Set MOpsselect = Range(MOps1, MOps)

Sheets("Mktg Influenced Opps").Select
MOpsselect.RemoveDuplicates Columns:=4, Header:=xlYes


'--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 Dashboard to Campaign Summary data
Dim Csumm, Csumm1, Csummselect As Range
Set Csumm = Sheets("Campaign Summary Data").Range("S1").End(xlDown)
Set Csumm1 = Sheets("Campaign Summary Data").Range("A1")
Set Csummselect = Range(Csumm1, Csumm)
Sheets("Dashboard").Select
Range("A1:S" & LastRow1).Select
Selection.Copy
Sheets("Campaign Summary Data").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Csummselect.RemoveDuplicates Columns:=3, Header:=xlYes


sPercentage = 80
IncrementalProgress.Increment sPercentage, sStatus

'--Copy and paste Q3 Karl Dashboard to current QBR workbook
Dim kdash, kdash1, kdselect As Range
Set kdash = Sheets("Karl Dashboard").Range("S3").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("Q4 2011 QBR Metrics Report Template.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


'--Second half of table
Workbooks("Q3 QBR Metrics Report Template.xlsm").Sheets("Karl Dashboard").Activate

Dim dash, dash1, dashselect As Range
Set dash = Sheets("Karl Dashboard").Range("B3").End(xlDown).End(xlDown)
Set dash1 = Sheets("Karl Dashboard").Range("S3").End(xlDown).End(xlDown).End(xlDown)
Set dashselect = Range(dash, dash1)

dashselect.Select
Selection.Copy
Workbooks("Q4 2011 QBR Metrics Report Template.xlsm").Sheets("Karl Dashboard").Activate

'--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.Offset(0, 1).Select
Selection.End(xlDown).End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'--Paste Total
Workbooks("Q3 QBR Metrics Report Template.xlsm").Sheets("Karl Dashboard").Activate

Dim tr, tr1, trselect As Range
Set tr = Sheets("Karl Dashboard").Range("B3").End(xlDown).End(xlDown).End(xlDown).End(xlDown)
Set tr1 = Sheets("Karl Dashboard").Range("S3").End(xlDown).End(xlDown).End(xlDown).End(xlDown)
Set trselect = Range(tr, tr1)
Dim FoundCells As Range
Dim LastCells As Range
Dim FirstAddrs As String

trselect.Select
Selection.Copy
Workbooks("Q4 2011 QBR Metrics Report Template.xlsm").Sheets("Karl Dashboard").Activate

'--Find Total
With Range("A22:A50")
Set LastCells = .Cells(.Cells.Count)
End With
Set FoundCells = Range("A22:A50").Find(what:="Grand Total", After:=LastCells)

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

sPercentage = 90
IncrementalProgress.Increment sPercentage, sStatus

'--Copy paste values of Dashboard
Sheets("Dashboard").Select
Range("B1:S" & LastRow).Selcect
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", "Sheet2", "date_time")
For Each ShtName In ShtsToShow
Worksheets(ShtName).Visible = xlSheetHidden
Next ShtName


'--Save a copy as xlsx
ChDir "C:\Users\msalget\Documents\Metrics\Bi Weekly Metrics"
ActiveWorkbook.SaveAs Filename:="Bi Weekly Metrics" & Format(Date, "mmddyyyy") & ".xlsx"

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
 
Upvote 0
Hopefully this is what you mean when you say code blocks. Here is the entire code. Every thing works fine until the part initially posted and trying to refresh all reports. This also is the part that errors out with runtime error '91' on my co-workers computer.

Thank you for any and all help!

Thank you Michael M for the help getting this formatted.

Code:
Code: 
Function SFDC_Login() As Boolean
If Not SFDCExcelAddin.IsLoggedIn Then SFDCExcelAddin.Login
SFDC_Login = SFDCExcelAddin.IsLoggedIn
End Function
Function SFDC_RefreshAll() As Boolean

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
SFDCExcelAddin.RefreshAll
Application.DisplayAlerts = False
'Application.OnTime Now + TimeValue("00:03:00"), "MakeAsyncRequest"
IncrementalProgress.Show
sPercentage = 10
sStatus = "Reports are Refreshed"
IncrementalProgress.Increment sPercentage, sStatus


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

 Sheets("Campaign with Campaign Members").Select
 WithCselect.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


'--Autofill all formulas for Column AK & AN
Range("AK2:AN2").AutoFill Destination:=Range("AK2:AN" & LastRow)
ActiveWorkbook.Worksheets("Deduped Lead Contact Data").AutoFilter.Sort. _
        SortFields.Add Key:=Range("AN1"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
ActiveSheet.Range("$A$1:AN" & LastRow).RemoveDuplicates Columns:=23, Header:= _
        xlYes
    With ActiveWorkbook.Worksheets("Deduped Lead Contact Data").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With



'--Old DedupCampaigns Macro
Dim WwithC, Wwith1, Wwithselect As Range
   Set WwithC = Sheets("Campaign with Campaign Members").Range("AE1").End(xlDown).Offset(0, 2)
   Set WwithC1 = Sheets("Campaign with Campaign Members").Range("B1")
   Set WwithCselect = Range(WwithC1, WwithC)
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
WwithCselect.Select
Selection.Copy
Sheets("Deduped Campaign Data").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
DCDselect.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
 Range("A1").Select
 NewDDselect.Select
 Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal


sPercentage = 30
IncrementalProgress.Increment sPercentage, sStatus

'--Dedupe Opps in Mktg Influenced Opps based on Opp ID
Dim MKops, MKops1, MKopsselect As Range
   Set MKops = Sheets("Mktg influenced opps").Range("AA1").End(xlDown)
   Set MKops1 = Sheets("Mktg influenced opps").Range("A1")
   Set MKopsselect = Range(MKops1, MKops)

Sheets("Mktg Influenced Opps").Select
MKopsselect.RemoveDuplicates Columns:=4, Header:=xlYes



'--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 Dashboard to Campaign Summary data
Dim CSD, CSD1, CSDselect As Range
   Set CSD = Sheets("Campaign Summary Data").Range("S1").End(xlDown)
   Set CSD1 = Sheets("Campaign Summary Data").Range("A1")
   Set CSDselect = Range(CSD1, CSD)
Sheets("Dashboard").Select
Range("A1:S" & LastRow1).Select
Selection.Copy
Sheets("Campaign Summary Data").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
CSDselect.RemoveDuplicates Columns:=3, Header:=xlYes

'--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/00O70000002wkBd"
        .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




'--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 QBR Metrics Report Template"
Workbooks("Q3 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

 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)

Sheets("Campaign with Campaign Members").Select
 campselect.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


'--Autofill all formulas for Column AK & AN
Range("AK2:AN2").AutoFill Destination:=Range("AK2:AN" & LastRow)
ActiveWorkbook.Worksheets("Deduped Lead Contact Data").AutoFilter.Sort. _
        SortFields.Add Key:=Range("AN1"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
ActiveSheet.Range("$A$1:AN" & LastRow).RemoveDuplicates Columns:=23, Header:= _
        xlYes
    With ActiveWorkbook.Worksheets("Deduped Lead Contact Data").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With



'--Old DedupCampaigns Macro
Dim wmemb, wmemb1, wmembselect As Range
   Set wmemb = Sheets("Campaign with Campaign Members").Range("AE1").End(xlDown).Offset(0, 2)
   Set wmemb1 = Sheets("Campaign with Campaign Members").Range("B1")
   Set wmembselect = Range(wmemb1, wmemb)
Dim ddupe, ddupe1, ddupeselect As Range
   Set ddupe = Sheets("DeDuped Campaign Data").Range("AD1").End(xlDown).Offset(0, 2)
   Set ddupe1 = Sheets("DeDuped Campaign Data").Range("A1")
   Set ddupeselect = Range(ddupe1, ddupe)

Sheets("Campaign with Campaign Members").Select
wmembselect.Select
Selection.Copy
Sheets("Deduped Campaign Data").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
ddupeselect.RemoveDuplicates Columns:=1, Header:=xlYes



'--Copy data from Campaigns wo Campaign Members
 Dim wout, wout1, woutselect As Range
   Set wout = Sheets("Campaigns wo Campaign Members").Range("AD2").End(xlDown).Offset(0, 1)
   Set wout1 = Sheets("Campaigns wo Campaign Members").Range("A2")
   Set woutselect = Range(wout1, wout)
 Dim DData, DData1, DDataselect As Range
   Set DData = Sheets("DeDuped Campaign Data").Range("AD1").End(xlDown).Offset(0, 2)
   Set DData1 = Sheets("DeDuped Campaign Data").Range("A1")
   Set DDataselect = Range(DData1, DData)

 Sheets("Campaigns wo Campaign Members").Select
 woutselect.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
 Range("A1").Select
 DDataselect.Select
 Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal


sPercentage = 60
IncrementalProgress.Increment sPercentage, sStatus

'--Dedupe Opps in Mktg Influenced Opps based on Opp ID
Dim MOps, MOps1, MOpsselect As Range
   Set MOps = Sheets("Mktg influenced opps").Range("AA1").End(xlDown)
   Set MOps1 = Sheets("Mktg influenced opps").Range("A1")
   Set MOpsselect = Range(MOps1, MOps)

Sheets("Mktg Influenced Opps").Select
MOpsselect.RemoveDuplicates Columns:=4, Header:=xlYes


'--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 Dashboard to Campaign Summary data
Dim Csumm, Csumm1, Csummselect As Range
   Set Csumm = Sheets("Campaign Summary Data").Range("S1").End(xlDown)
   Set Csumm1 = Sheets("Campaign Summary Data").Range("A1")
   Set Csummselect = Range(Csumm1, Csumm)
Sheets("Dashboard").Select
Range("A1:S" & LastRow1).Select
Selection.Copy
Sheets("Campaign Summary Data").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Csummselect.RemoveDuplicates Columns:=3, Header:=xlYes


sPercentage = 80
IncrementalProgress.Increment sPercentage, sStatus

'--Copy and paste Q3 Karl Dashboard to current QBR workbook
Dim kdash, kdash1, kdselect As Range
   Set kdash = Sheets("Karl Dashboard").Range("S3").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("Q4 2011 QBR Metrics Report Template.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


'--Second half of table
Workbooks("Q3 QBR Metrics Report Template.xlsm").Sheets("Karl Dashboard").Activate

Dim dash, dash1, dashselect As Range
    Set dash = Sheets("Karl Dashboard").Range("B3").End(xlDown).End(xlDown)
    Set dash1 = Sheets("Karl Dashboard").Range("S3").End(xlDown).End(xlDown).End(xlDown)
    Set dashselect = Range(dash, dash1)

dashselect.Select
Selection.Copy
Workbooks("Q4 2011 QBR Metrics Report Template.xlsm").Sheets("Karl Dashboard").Activate

'--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.Offset(0, 1).Select
Selection.End(xlDown).End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'--Paste Total
Workbooks("Q3 QBR Metrics Report Template.xlsm").Sheets("Karl Dashboard").Activate

Dim tr, tr1, trselect As Range
    Set tr = Sheets("Karl Dashboard").Range("B3").End(xlDown).End(xlDown).End(xlDown).End(xlDown)
    Set tr1 = Sheets("Karl Dashboard").Range("S3").End(xlDown).End(xlDown).End(xlDown).End(xlDown)
    Set trselect = Range(tr, tr1)
Dim FoundCells As Range
Dim LastCells As Range
Dim FirstAddrs As String

trselect.Select
Selection.Copy
Workbooks("Q4 2011 QBR Metrics Report Template.xlsm").Sheets("Karl Dashboard").Activate

'--Find Total
With Range("A22:A50")
    Set LastCells = .Cells(.Cells.Count)
End With
Set FoundCells = Range("A22:A50").Find(what:="Grand Total", After:=LastCells)

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

sPercentage = 90
IncrementalProgress.Increment sPercentage, sStatus

'--Copy paste values of Dashboard
Sheets("Dashboard").Select
Range("B1:S" & LastRow).Selcect
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", "Sheet2", "date_time")
For Each ShtName In ShtsToShow
    Worksheets(ShtName).Visible = xlSheetHidden
Next ShtName


'--Save a copy as xlsx
 ChDir "C:\Users\msalget\Documents\Metrics\Bi Weekly Metrics"
 ActiveWorkbook.SaveAs Filename:="Bi Weekly Metrics" & Format(Date, "mmddyyyy") & ".xlsx"

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
 
Last edited:
Upvote 0
It does if you put the code inside code tags
[ code]...at the start of the code
[ /code]..at the end of the code
without the space !
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
308
RoryA
RoryA
N
  • Solved
Copy headers across sheets no longer works.
Replies
7
Views
400
NoSparks
N
J
  • Question
Issue with Macros and renaming files
Replies
6
Views
476
kevin9999
K
M
  • Question
Loop through each file in folder and perform an action
Replies
0
Views
453
Monsieur Roo
M
J
  • Solved
Unable to find error in code - Runtime 1004 error.
Replies
4
Views
552
Justplainj
J

Forum statistics

Threads
1,214,379
Messages
6,119,190
Members
448,874
Latest member
Lancelots

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