How to calculate certain cells on two different worksheets in Excell using VB Macro?

Dear All,

I am a new in macro scripting. I have question on how to calculate the certain cells between 2 different worksheets based on the certain calculation parameters and the comparison result (the report) is put into the new worksheet on the same workbooks.

1) Worksheet1 contains: DEPTH, G1, C1, N1, D1, S1, SR1, MR1, DR1
2) Worksheet2 contains: DEPTH, G2, C2, N2, D2, S2, SR2, MR2, DR2

Expected result should be put in Worksheet3: DEPTH, G1, G2, calculation(G1 and G2), CI1, C2, calculation(C1 and C2), so on until the last columns.
(Please find example on attached file "Test_Data.xls)

What I have done is to create a template to be filled in by copy and paste DEPTH, G1, G2 on worksheet1, DEPTH, C1, C2 on worksheet2, so on (attached file "Template_QC.xls"). Then I create a calculation macro for each of those worksheets separately to calculate the difference and color them . The calculation macro that I used is as follows:

Public Sub GTemplate()
  Dim LastRow As Long, iRow As Long
  Dim diff As Double
  LastRow = Range("A1:D1").SpecialCells(xlLastCell).Row
  For iRow = 2 To LastRow
    Cells(iRow, "D").Value = Cells(iRow, "C").Value - Cells(iRow, "B").Value
    If Cells(iRow, "D").Value >= 2 Or Cells(iRow, "D").Value <= -2 Then
        Range(Cells(iRow, "D"), Cells(iRow, "D")).Select
        Selection.Interior.ColorIndex = 3
    Else
        Range(Cells(iRow, "D"), Cells(iRow, "D")).Select
        Selection.Interior.ColorIndex = 43
    End If
  Next iRow
End Sub

That macro above is applied to all worksheets, except the calculation function and number mentioned in "If Cells(iRow, "D").Value >= 2 Or Cells(iRow, "D").Value <= -2" are different from one worksheet to the other

In other words it is still a bit manual works. Now, how can I automatically calculate my 2 worksheets based on my calculation parameters above and put the resulted report in worksheet3 using VB Macro in my workbook?

Regards,
WiD

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

Try this:

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 & "")
        .FormulaR1C1 = "=RC[-1]-RC[-2]"
        .Interior.ColorIndex = 43
    End With
    
    Range("D2:D" & LR).FormatConditions.Add Type:=xlCellValue, Operator:=xlNotBetween, Formula1:="1.99", Formula2:="-1.99"
    Range("D2:D" & LR).FormatConditions(1).Interior.ColorIndex = 3
    Range("G2:G" & LR).FormatConditions.Add Type:=xlCellValue, Operator:=xlNotBetween, Formula1:="0.009", Formula2:="-0.009"
    Range("G2:G" & LR).FormatConditions(1).Interior.ColorIndex = 3
    Range("J2:J" & LR).FormatConditions.Add Type:=xlCellValue, Operator:=xlNotBetween, Formula1:="0.0089", Formula2:="-0.0089"
    Range("J2:J" & LR).FormatConditions(1).Interior.ColorIndex = 3
    Range("M2:M" & LR).FormatConditions.Add Type:=xlCellValue, Operator:=xlNotBetween, Formula1:="0.0049", Formula2:="-0.0049"
    Range("M2:M" & LR).FormatConditions(1).Interior.ColorIndex = 3
    Range("P2:P" & LR).FormatConditions.Add Type:=xlCellValue, Operator:=xlNotBetween, Formula1:="2.99", Formula2:="-2.99"
    Range("P2:P" & LR).FormatConditions(1).Interior.ColorIndex = 3
    
    With Range("S2:S" & LR & ",V2:V" & LR & ",Y2:Y" & LR & "")
        .FormulaR1C1 = "=RC[-1]/RC[-2]"
        .Interior.ColorIndex = 43
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlNotBetween, Formula1:="1.04", Formula2:="1"
        .FormatConditions(1).Interior.ColorIndex = 3
    End With
End Sub

JB,

Thanks again..It works!
It is solved now..btw how to mark this thread already "SOLVED"?

Regards,
WiD

If that takes care of your need, be sure to EDIT your original post, click Go Advanced and mark the PREFIX box [SOLVED].


(Also, use the blue "scales" icon in our posts to leave Reputation Feedback, it is appreciated)