VBA - Change a line in a code

[montecarlo2012]

Hello.

Sub forum_Mrexcel()

Dim rngStart As Range, rngData As Range
Dim Diff1 As Long, Diff2 As Long, NoRows As Long, NoCols As Long, i As Long
Dim s As String

Set rngData = Range("B3:G2720")
      NoRows = rngData.Rows.Count
      NoCols = rngData.Columns.Count
                      Diff1 = 6
                      Diff2 = 60
      Set rngStart = Range("I3").Resize(, NoCols)

                   For i = Diff1 To Diff2
                               With rngStart.Offset(, (NoCols + 1) * (i - Diff1)).Resize(NoRows - i)
                                        .Rows(0).Formula = "=SUMPRODUCT(--(" & rngData.Resize(NoRows - i, 1).Address(0, 0) & "=" & .Columns(1).Address(0, 0) & "))"
                                        .Rows(0).Font.Bold = ture
                                        .Formula = "=TRUNC(Average(" & rngData.Resize(i + 1, 1).Address(0, 0) & "))"
                                        s = .Cells(1, 1).Address(0, 0)
                                                With .FormatConditions
                                                        .Delete
                                                        .Add Type:=xlExpression, Formula1:="=" & rngData(1, 1).Address(0, 0) & "=" & s
                                                        .Item(1).Interior.Color = vbYellow
                                                End With
                               End With
                   Next i
End Sub

The code give me all the results on row 2 until the last calculation, and looks like

So Visually is difficult to handle, reason why I would like the same results on sheet 2
but as an array form. Something like

Please anyway to tell me what line I have to change, or maybe the code entirely,
Thank you for reading this.

 

[StephenCrump]

Perhaps:

Sub forum_Mrexcel()

    Dim rngStart As Range, rngData As Range, Summary As Range
    Dim Diff1 As Long, Diff2 As Long, NoRows As Long, NoCols As Long, i As Long
    Dim s As String
    
    Set rngData = Range("B3:G2720")
    NoRows = rngData.Rows.Count
    NoCols = rngData.Columns.Count
    Diff1 = 6
    Diff2 = 60
    Set rngStart = Range("I3").Resize(, NoCols)
    Set Summary = Worksheets("Sheet2").Range("A1").Resize(, NoCols) 'Adjust Sheet2 and A1 as appropriate

    For i = Diff1 To Diff2
        With rngStart.Offset(, (NoCols + 1) * (i - Diff1)).Resize(NoRows - i)
            .Rows(0).Formula = "=SUMPRODUCT(--(" & rngData.Resize(NoRows - i, 1).Address(0, 0) & "=" & .Columns(1).Address(0, 0) & "))"
            .Rows(0).Font.Bold = True
            .Formula = "=TRUNC(Average(" & rngData.Resize(i + 1, 1).Address(0, 0) & "))"
            Summary.Rows(i + 1 - Diff1).Value = .Rows(0).Value
            s = .Cells(1, 1).Address(0, 0)
            With .FormatConditions
                .Delete
                .Add Type:=xlExpression, Formula1:="=" & rngData(1, 1).Address(0, 0) & "=" & s
                .Item(1).Interior.Color = vbYellow
            End With
        End With
    Next i

End Sub

 

[montecarlo2012]

StephenCrump, Thank you Sir. Great job, work perfect.
If you don't mind Sir, where do you study VBA.

 

[StephenCrump]

.. where do you study VBA.

Mostly here, and part-time at Google College.

 

[montecarlo2012]

Thank you Sir for taking time to answer me.