Read sheet 3 results on sheet 1

[montecarlo2012]

Hello.

Option Explicit

Sub woren()
Worksheets("sheet3").Activate

Dim rng  As Range, Dn As Range, Rw As Range
Dim n       As Long
Dim Q As Variant
Dim Omax    As Integer, oSub As Integer


Set rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp)).Resize(, 3)
    ReDim Ray(1 To rng.Count, 1 To 2)
    
With CreateObject("scripting.dictionary")
                  .CompareMode = vbTextCompare
                  
                  For Each Rw In rng.Rows
                                    n = n + 1
                                                   For Each Dn In Rw.Columns
                                                   
                                                               If Not .exists(Dn.Value) Then
                                                                           Ray(1, 1) = n - 1: Ray(1, 2) = n - 1
                                                                           .Add Dn.Value, Array(Ray, 1)
                                                                           Else
                                                                           Q = .Item(Dn.Value)
                                                                           Q(1) = Q(1) + 1
                                                                           oSub = IIf(Q(1) > 2, 1, 2)
                                                                           Q(0)(Q(1), 1) = n
                                                                           Q(0)(Q(1), 2) = n - Q(0)(Q(1) - 1, 1) - oSub
                                                                           Omax = Application.Max(Omax, Q(1))
                                                                           .Item(Dn.Value) = Q
                                                               End If
                                                   Next Dn
                                    Next Rw
                                    
                  Dim K As Variant
                  Dim R As Long
                  Dim c As Long
                  c = 1
                              For Each K In .keys
                                          c = c + 1
                                          Cells(c, 7) = K                                                '' Column G, with the list of numbers you want to report
                                          Cells(c, 12).Font.Bold = True                         'location for the results
                                          
                                                   For R = 1 To .Item(K)(1)
                                                               Cells(c, 12 + R) = .Item(K)(0)(R, 2)
                                                   Next R
                              Next K
                              
                  Sheet1.Range("G2").Resize(.Count, Omax + 3).Sort Range("G2"), xlAscending 'the bin from 1 to end
                  Call RwData(Range("M2").Resize(.Count), Omax) ' this is the skip report starter or column 13
End With
End Sub
Sub RwData(rng As Range, col As Integer)

Range("J1").Value = "AVERAGE"
   Range("K1").Value = "DEVIATION"
   Range("N1").Value = "ABSENT"
Range("M1").Value = "DELAY"
Range("I1").Value = "OUTAVG"

Dim Dn As Range
For Each Dn In rng
With Application
   
   
    Dn.Offset(, -3) = Round((.Average(Dn.Resize(, .CountA(Dn.Resize(, col))))), 1) 'this is colum J ==============or 10 [or -3 from 13]
    


    Dn.Offset(, -4) = Round((Abs(Dn / .Average(Dn.Resize(, .CountA(Dn.Resize(, col)))))), 1)
    
    Dn.Offset(, -2) = Fix(Abs(Dn - .Average(Dn.Resize(, .CountA(Dn.Resize(, col)))))) 'column K or -2 from 13
   
  Dn.Offset(, -5) = Dn - Cells(2, 10).Value
   
    
End With
Next Dn
End Sub

I would like this code Read the array on sheet 3 and display the results on sheet 1

Thank you for your time.

 

[OaklandJim]

I took a look at your code and wasn't able to understand what is going on. Maybe use more descriptive names for variables. I know that purists don't like that -- longer var names -- but it really helps with readability especially if someone else may have to look at your code. Add comments too so that what you mean to do is more obvious. Also, the indenting that you have makes reading the code challenging.

 

[montecarlo2012]

Hello OaklandJim, thanks for your time reading this.
This code count intervals between the same value in a array, everything is working good.
What I would like to to change the display part to another sheet.
my dent is trying to highlight the loops, so you can see where everything start and end
and the last part is just calculations.

 

[OaklandJim]

Hello montecarlo2012.

I cannot tell from your code what is happening. Like I said, for me, it helps A LOT to give descriptive names to variables. To me your indenting is also difficult to follow. Use one TAB to indent the next code "nest."

I tried to be helpful. From what I could see the code below might be something like what you want. It may not be. But without data and without understanding what is happening with your code I can't test the code and I cannot see what else to suggest. I hope that it helps.

Sub woren()

    Dim rng  As Range, Dn As Range, Rw As Range
    
    Dim n As Long
    
    Dim Q As Variant
    
    Dim Omax As Integer
    
    Dim oSub As Integer

    Dim K As Variant
    
    Dim R As Long
    
    Dim c As Long

    Worksheets("sheet3").Activate

    Set rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp)).Resize(, 3)
    
    ReDim Ray(1 To rng.Count, 1 To 2)
    
    With CreateObject("scripting.dictionary")
        
        .CompareMode = vbTextCompare
                  
        For Each Rw In rng.Rows
            n = n + 1
            For Each Dn In Rw.Columns
                                               
                If Not .exists(Dn.Value) Then
                    Ray(1, 1) = n - 1: Ray(1, 2) = n - 1
                    .Add Dn.Value, Array(Ray, 1)
                Else
                    Q = .Item(Dn.Value)
                    Q(1) = Q(1) + 1
                    oSub = IIf(Q(1) > 2, 1, 2)
                    Q(0)(Q(1), 1) = n
                    Q(0)(Q(1), 2) = n - Q(0)(Q(1) - 1, 1) - oSub
                    Omax = Application.Max(Omax, Q(1))
                    .Item(Dn.Value) = Q
                End If
            
            Next Dn
        
        Next Rw
                                    
        c = 1
        
        For Each K In .keys
            c = c + 1
            
'           Column G, with the list of numbers you want to report
            Cells(c, 7) = K
            
'           location for the results
            Cells(c, 12).Font.Bold = True
                    
            For R = 1 To .Item(K)(1)
                        Cells(c, 12 + R) = .Item(K)(0)(R, 2)
            Next R
        Next K
                              
        Sheet1.Range("G2").Resize(.Count, Omax + 3).Sort Range("G2"), xlAscending 'the bin from 1 to end
        Call RwData(Range("M2").Resize(.Count), Omax) ' this is the skip report starter or column 13
    End With

End Sub

Sub RwData(rng As Range, col As Long)

    Dim wsResults As Worksheet

    Dim Dn As Range

    Dim iDataRow As Long

    Set wsResults = ThisWorkbook.Worksheets("Sheet1")
    
    With wsResults
        Range("I1").Value = "OUTAVG"
        Range("J1").Value = "AVERAGE"
        Range("K1").Value = "DEVIATION"
        Range("M1").Value = "DELAY"
        Range("N1").Value = "ABSENT"
    End With

    For Each Dn In rng
    
        'With Application ' not sure what this does?
        
'       Use cell H1 as the anchor cell for results
        With wsResults.Cells(1, Col-5)
        
            iDataRow = iDataRow + 1
            
'           column H (8) -- -5 from column 13
            .Offset(iDataRow, 0) = Dn - Cells(2, 10).Value
        
'           column I (9) -- -4 from column 13
            .Offset(iDataRow, 1) = Round((Abs(Dn / .Average(Dn.Resize(, .CountA(Dn.Resize(, col)))))), 1)

'           column J (10) -- -3 from column 13
            .Offset(iDataRow, 2) = Round((.Average(Dn.Resize(, .CountA(Dn.Resize(, col))))), 1)

'           column K (11) or -2 from 13
            .Offset(iDataRow, 3) = Fix(Abs(Dn - .Average(Dn.Resize(, .CountA(Dn.Resize(, col))))))
        
        End With
    
    Next Dn

End Sub

 

[montecarlo2012]

Thank you I already mark as solution.