Generate random number to three digits with Norm_inv OR optimize the function-CodePudding

I wrote a macro to generate random number from sample.

The RNG code is:

For i = 6 To LR

    Set row = RANGE(Cells(i, 8), Cells(i, LC))

    prumer = Application.Average(row)
    smodch = Application.stdev(row)
    
    For A = B To LCNEW
        Cells(i, A).Value = Application.Norm_Inv(Rnd(), prumer, smodch)
        Cells(i, A).Value = Application.ROUND(Cells(i, A).Value, 3)
        Cells(i, A).NumberFormat = "0.000"
    Next A
    
Next i

It takes a row, calculates average and stdev and then does the stuff.

On my computer it runs quickly, like 5-10 sec for 80 rows with 10 numbers and calculating 100 more randomized.

On an older computer it runs like 5 minutes! How can I calculate norm inv only to three digits or optimize it?

The whole code:

Sub RNGTOX()

   Dim lastcell As RANGE
   Dim row As RANGE
   Dim i As Long
   Dim A As Long
   Dim B As Long
   Dim prumer As Variant
   Dim smodch As Variant
   Dim LR As Long
   Dim LC As Long
   Dim ocislovani As RANGE
   Dim sSIDE As Worksheet

If RANGE("H6").Value = vbNullString Then
    MsgBox "Chybí data."
    Exit Sub
End If
            
Application.ScreenUpdating = False
     
Set sSIDE = ActiveSheet
Set lastcell = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)

LR = Cells(Rows.count, 1).End(xlUp).row
LC = Cells(6, Columns.count).End(xlToLeft).Column
B = LC   1
LCNEW = RANGE("B2").Value   7

If LCNEW <= LC Then
    MsgBox "Počet už je dosažený. Není třeba dopočítávat."
    Exit Sub
Else
End If

'ocislovani souboru
Set ocislovani = sSIDE.RANGE(sSIDE.Cells(5, 8), sSIDE.Cells(5, LCNEW))

counter_cisla = 1
For Each cell_a In ocislovani
    cell_a.Value = counter_cisla
    counter_cisla = counter_cisla   1
Next cell_a

'i radek, A sloupec
For i = 6 To LR

    Set row = RANGE(Cells(i, 8), Cells(i, LC))

    prumer = Application.Average(row)
    smodch = Application.stdev(row)
    
    For A = B To LCNEW
        Cells(i, A).Value = Application.Norm_Inv(Rnd(), prumer, smodch)
        Cells(i, A).Value = Application.ROUND(Cells(i, A).Value, 3)
        Cells(i, A).NumberFormat = "0.000"
    Next A
    
Next i

RANGE("H6").Select
       
Application.ScreenUpdating = True

End Sub

CodePudding user response：

Please, try the next code. It processes the range in memory, loading an array and its content is dropped at once in the appropriate range. Also, writing a value in a cell then round it, place it back and format each cell takes time...:

Sub RNGTOX()
   Dim lastcell As Range, row As Range, i As Long, A As Long, B As Long
   Dim prumer As Variant, smodch As Variant, LR As Long, LC As Long, LCNEW As Long
   Dim ocislovani As Range, sSIDE As Worksheet
        
  If Range("H6").Value = vbNullString Then
    MsgBox "Chybí data."
    Exit Sub
  End If
     
 Set sSIDE = ActiveSheet
 Set lastcell = sSIDE.cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)

 LR = sSIDE.cells(sSIDE.rows.count, 1).End(xlUp).row
 LC = sSIDE.cells(6, sSIDE.Columns.count).End(xlToLeft).Column
 B = LC   1
 LCNEW = sSIDE.Range("B2").Value   7

If LCNEW <= LC Then
    MsgBox "Pocet už je dosažený. Není treba dopocítávat."
    Exit Sub
End If

 'ocislovani souboru
 Set ocislovani = sSIDE.Range(sSIDE.cells(5, 8), sSIDE.cells(5, LCNEW))
 ocislovani.Value = Evaluate("TRANSPOSE(ROW(1:" & LCNEW & "))")

 Dim rng As Range, arr
 Set rng = sSIDE.Range(sSIDE.cells(6, 8), sSIDE.cells(LR, LC))

 ReDim arr(1 To rng.rows.count, 1 To LCNEW - B   1) 'redim the array to keep the processed values
 For i = 1 To rng.rows.count
    'Set row = rng.rows(i) ' Range(cells(i, 8), cells(i, LC))
    
    prumer = Application.Average(rng.rows(i))
    smodch = Application.StDev(rng.rows(i))
    
    For A = 1 To UBound(arr, 2)  'LCNEW
       arr(i, A) = Round(Application.Norm_Inv(Rnd(), prumer, smodch), 3) 'load the array (working in memory)
    Next A
 Next i

  'drop the array content, at once:
  With sSIDE.cells(6, B).Resize(UBound(arr), UBound(arr, 2))
        .Value = arr
        .NumberFormat = "0.000"
  End With
 
 Range("H6").Select
 MsgBox "Ready..."
End Sub

The code is not tested, not having an appropriate environment, but (if I correctly understood your code logic) it should work.

Please, test it and send some feedback.