Based on the order of the data in the two worksheets ACTUALLY being the same (row 2 on both sheets go together), this macro will assemble your
Calculation Report for you without the need for a "loop" to apply the conditional coloring.
Give it a try on a more complete data set.
Option Explicit
Public Sub GTemplate()
'JBeaucaire (9/8/2009)
Dim LR As Long
Dim Rpt As Worksheet, dsh1 As Worksheet, dsh2 As Worksheet
Set Rpt = Sheets("Calculation Report")
Set dsh1 = Sheets("Worksheet1")
Set dsh2 = Sheets("Worksheet2")
'Clear existing report
Rpt.Range("A2:AA" & Rows.Count).Clear
'Copy data from first worksheet
LR = dsh1.Range("A" & Rows.Count).End(xlUp).Row
dsh1.Range("A2:B" & LR).Copy Rpt.Range("A2")
dsh1.Range("C2:C" & LR).Copy Rpt.Range("E2")
dsh1.Range("D2:D" & LR).Copy Rpt.Range("H2")
dsh1.Range("E2:E" & LR).Copy Rpt.Range("K2")
dsh1.Range("F2:F" & LR).Copy Rpt.Range("N2")
dsh1.Range("G2:G" & LR).Copy Rpt.Range("Q2")
dsh1.Range("H2:H" & LR).Copy Rpt.Range("T2")
dsh1.Range("I2:I" & LR).Copy Rpt.Range("W2")
'Copy data from second worksheet
dsh2.Range("B2:B" & LR).Copy Rpt.Range("C2")
dsh2.Range("C2:C" & LR).Copy Rpt.Range("F2")
dsh2.Range("D2:D" & LR).Copy Rpt.Range("I2")
dsh2.Range("E2:E" & LR).Copy Rpt.Range("L2")
dsh2.Range("F2:F" & LR).Copy Rpt.Range("O2")
dsh2.Range("G2:G" & LR).Copy Rpt.Range("R2")
dsh2.Range("H2:H" & LR).Copy Rpt.Range("U2")
dsh2.Range("I2:I" & LR).Copy Rpt.Range("X2")
'Add formulas and formatting
Rpt.Activate
LR = Range("A" & Rows.Count).End(xlUp).Row
With Range("D2:D" & LR & ",G2:G" & LR & ",J2:J" & LR & ",M2:M" & LR & ",P2:P" & LR & ",S2:S" & LR & ",V2:V" & LR & ",Y2:Y" & LR & "")
.FormulaR1C1 = "=RC[-1]-RC[-2]"
.Interior.ColorIndex = 43
.FormatConditions.Add Type:=xlExpression, Formula1:="=ABS(C2-B2)>=2"
.FormatConditions(1).Interior.ColorIndex = 3
End With
End Sub
Bookmarks