Debugging Macro to Copy over just Conditional Formatting

[aadilshakir]

Hi,

I am working on a macro which copies data from multiple sheets, creates a new sheet and pastes it in the new sheet sequentially and then sorts the data based on a column called "Region". But, every time this macro is run the conditional formatting rules change their ranges and multiply. maybe I thought it's because of all the CF from the original sheets are getting added which is sort of messing up the ranges and multiplying the rules. So once the new sheet is ready, I strip it off of all the conditional formatting and then copy the CF from one of the sheets and paste it with paste special -> formats on the new sheet but it still isn't carrying over the CF.

I am using Excel 2010 and here is my code which only shows the part where the CF is stripped off, haven't included the pastespecial for formats to the new sheet, any help would be really appreciated:


Sub Pull()

Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range

Dim Answer As Integer

Answer = MsgBox("How about clearing the Regional filters first?", vbYesNo + vbQuestion, "Not so fast Lisa!")

If Answer = vbYes Then
'GoTo Exit_The_Macro
Exit Sub

Else
'Keep going

Dim Password As String
Password = InputBox("Please enter password below", "Password", "Enter Here")
If Password <> "LisaCadence" Then
MsgBox "Incorrect Password"
Exit Sub
Else
End If

'Here you write the code you want to run when the user has the right password


With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Delete the sheet "Master SIOC Projects Original" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Master SIOC Projects Original").Delete

On Error GoTo 0
Application.DisplayAlerts = True


'Rename "Master SIOC Projects" to "Master SIOC Projects Original"

Sheets("Master SIOC Projects").Select
Sheets("Master SIOC Projects").Name = "Master SIOC Projects Original"



'Add a worksheet with the name "Master SIOC Projects"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Master SIOC Projects"
ActiveWindow.Zoom = 58
' DestSh.Columns.AutoFit
DestSh.Rows.AutoFit


'Copy first 18 rows into new sheet

Sheets("Master SIOC Projects Original").Select
Rows("1:4").Select
Selection.Copy
Sheets("Master SIOC Projects").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

'Copy Headers Row

Sheets("Master SIOC Projects Original").Select
Range("A5:XFD5").Select
Selection.Copy
Sheets("Master SIOC Projects").Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlPasteAll
Application.CutCopyMode = False


Range("A6").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.RowHeight = 80

'loop through the sheets specified in the array, add additional to the list if need be
For Each sh In ActiveWorkbook.Sheets(Array("West", "East", "Optimization", "Unknown", "CAN"))



'Find the last row with data on the DestSh
Last = LastRow(DestSh)

'Fill in the range that you want to copy
Set CopyRng = sh.Range("A6:XFD" & LastRow(sh))

'Test if there enough rows in the DestSh to copy all the data
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"
GoTo ExitTheSub
End If

CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial Paste:=8
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteAll
Application.CutCopyMode = False
.Select
End With

DestSh.Range("A6:XFD" & LastRow(DestSh)).Select
Selection.FormatConditions.Delete

Next

ExitTheSub:

'Unlist table for Master SIOC Original and turn on filter

Sheets("Master SIOC Projects Original").Select
ActiveSheet.ListObjects(1).Unlist
Range("A5").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.AutoFilter
Range("A1").Select



'Converting to table

Sheets("Master SIOC Projects").Select
Range("A5").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$5:$BY" & LastRow(DestSh)), , xlYes).Name = _
"Table5"
Range("Table5[#All]").Select
ActiveSheet.ListObjects("Table5").TableStyle = "TableStyleMedium2"
Range("Table5[[#Headers],[Region]]").Select


'Sort based on Client
Selection.Sort _
Key1:=Range("C6"), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal



'Formulas

Range("H3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(Table5[Contract Status],""Signed*"")+COUNTIF(Table5[Contract Status],""Internal - Committed"")+COUNTIF(Table5[Contract Status], ""*MSS Assist"")"


Range("AI3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Non-SOO US Resource])"
Range("AJ3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Austin, Lisa])"
Range("AK3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Banerjee, Sourav])"
Range("AL3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Butler, Cindy])"
Range("AM3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Chhillar, Sanjay])"
Range("AN3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Connaway, Kirk])"
Range("AO3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Connolly, Jarrod (Intern)])"
Range("AP3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Costello, Tim])"
Range("AQ3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Daniels, Kory])"
Range("AR3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Fedorsky, Mike])"
Range("AS3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Fice, " & Chr(10) & "Bill])"
Range("AT3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Gautam, Seema])"
Range("AU3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Gillespie, Susan])"
Range("AV3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Gregory, Chuck])"
Range("AW3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Hagio, Akari])"
Range("AX3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Hendrick, Patrick])"
Range("AY3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Hunt, Mark])"
Range("AZ3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Hutchinson, Alden])"
Range("BA3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Isen, Angel])"
Range("BB3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Jarvis, John])"
Range("BC3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Jones, Derek])"
Range("BD3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Lam, Jeff])"
Range("BE3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Legge, Kevin])"
Range("BF3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[McGinley, Robert])"
Range("BG3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Miller, Kyle])"
Range("BH3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Morrison, Bryan])"
Range("BI3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Moy, Mike])"
Range("BJ3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Neely, Chad])"
Range("BK3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Nielsen, Leslie])"
Range("BL3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Ngan, Stephanie])"
Range("BM3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Patel, " & Chr(10) & "Jay])"
Range("BN3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Reichert, Dan])"
Range("BO3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Sarkar, Krishnan])"
Range("BP3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Sharma, Sandeep])"
Range("BQ3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Singh, Gursimran (Simmi)])"
Range("BR3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Smith, Stephen])"
Range("BS3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Sugars, Dan])"
Range("BT3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Taylor, Keith])"
Range("BU3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Tillford, Ben])"
Range("BV3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Tisch, William])"
Range("BW3").Select
ActiveCell.FormulaR1C1 = "=SUM(Table5[Whitson, John])"


Range("F4").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(Table5[Region],""East"", Table5[Contract Status],""Signed*"")+COUNTIFS(Table5[Region],""East"", Table5[Contract Status],""*Committed"")+COUNTIFS(Table5[Region],""East"", Table5[Contract Status], ""*MSS Assist"")+COUNTIFS(Table5[Region],""East"", Table5[Contract Status], ""Work@Risk"")+COUNTIFS(Table5[Region],""East"", Table5[Contract Status], ""*LOA*"")"
Range("I4").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(Table5[Region],""West"", Table5[Contract Status],""Signed*"")+COUNTIFS(Table5[Region],""West"", Table5[Contract Status],""*Committed"")+COUNTIFS(Table5[Region],""West"", Table5[Contract Status], ""*MSS Assist"")+COUNTIFS(Table5[Region],""West"", Table5[Contract Status], ""Work@Risk"")+COUNTIFS(Table5[Region],""West"", Table5[Contract Status], ""*LOA*"")"
Range("L4").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(Table5[Region],""CAN"", Table5[Contract Status],""Signed*"")+COUNTIFS(Table5[Region],""CAN"", Table5[Contract Status],""*Committed"")+COUNTIFS(Table5[Region],""CAN"", Table5[Contract Status], ""*MSS Assist"")+COUNTIFS(Table5[Region],""CAN"", Table5[Contract Status], ""Work@Risk"")+COUNTIFS(Table5[Region],""CAN"", Table5[Contract Status], ""*LOA*"")"
Range("P4").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS(Table5[Region],""Optimization"", Table5[Contract Status],""Signed*"")+COUNTIFS(Table5[Region],""Optimization"", Table5[Contract Status],""*Committed"")+COUNTIFS(Table5[Region],""Optimization"", Table5[Contract Status], ""*MSS Assist"")+COUNTIFS(Table5[Region],""Optimization"", Table5[Contract Status], ""Work@Risk"")+COUNTIFS(Table5[Region],""Optimization"", Table5[Contract Status], ""*LOA*"")"

Range("P4").Select

'Row and Column Size

Columns("A:A").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.ColumnWidth = 11
Columns("BX:BX").Select
Selection.ColumnWidth = 37.5

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End If

End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function




Any Suggestions or help would be greatly appreciated.