.vba. frequency of random numbers.

[montecarlo2012]

Hi all.

Sub Freq_Ran()

Dim freqs(), xxx As Range

Set xxx = Application.InputBox("Select the cell you want to process", "Location of souce data", Default:="$H$2:$H$2800", Type:=8)
 ''' I would like not to use inputbox instead just search for B2 to the last row

vals = xxx.Value
vmax = Application.Max(vals)
vmin = Application.Min(vals)

bin = Evaluate("row(A" & vmin & ":A" & vmax & ")")


freqs = Application.WorksheetFunction.FREQUENCY(vals, bin)

ReDim Preserve freqs(1 To UBound(freqs), 1 To 2)

For i = 1 To UBound(bin)
           freqs(i, 2) = bin(i, 1)
Next i

For i = 2 To UBound(bin)

For j = UBound(bin) To i Step -1

           If freqs(j, 1) < freqs(j - 1, 1) Then

           temp1 = freqs(j, 1): temp2 = freqs(j, 2)

           freqs(j, 1) = freqs(j - 1, 1): freqs(j, 2) = freqs(j - 1, 2)

          freqs(j - 1, 1) = temp1: freqs(j - 1, 2) = temp2

          End If

Next j

Next i



'determine size of array:

i = 1

ColCount = 0

Do

myMax = 1

ColCount = ColCount + 1

Do

          i = i + 1

            myMax = myMax + 1

                Loop Until freqs(i, 1) <> freqs(i - 1, 1)

                      If myMax > Max Then Max = myMax

                              Loop Until i >= UBound(bin)

       Dim Results()

     ReDim Results(1 To Max, 1 To ColCount + 1)

 i = 1: c = 1

Do

    r = 1

            Results(r, c) = freqs(i, 1)

                r = r + 1
 
Do

          Results(r, c) = freqs(i, 2)

              r = r + 1

                  i = i + 1

Loop Until freqs(i, 1) <> freqs(i - 1, 1)

c = c + 1

Loop Until i > UBound(bin)

Dim Destn As Range





Set Destn = Application.InputBox("Select the cell where do you want the results", "Location of result table", Type:=8)
'instead I would like to display directly on A92


Destn.Resize(UBound(Results), UBound(Results, 2)).Value = Results

Application.Goto Destn



End Sub

this code let me see the frequency of random numbers on column H and display anywhere
My problem now is I tried to do the same in a row, then do not work at all.

I would like to be able to change the input boxes, instead, would be nice if work for B2 to the last column and display results on A92

as a reference this is a images of the frequency result accomplish for this code

this code read column H and whatever found, regroup by frequency,
but now I need row B.
thanks for reading this
I would like to hear from you.

 

[Marc L]

Hi,​

​

values of Row B : ActiveSheet.UsedRange.Rows(2).Value2 …​

 

[montecarlo2012]

Thank you Marc L
This is what happen

 

[Marc L]

No idea without any attachment …​

 

[Marc L]

​

As a reminder my post #2 is a partial codeline for just the part reading some values but can't work as it is​

as you forgot to allocate a Variant variable to load these values …​

 

[montecarlo2012]

Marc L Thanks.
Sorry for the uncompleted post.
The Data to read is on ("B2 : last column")
Is a random numbers, that's why I need the frequency of whatever is in this row
and be regroup according to the frequency, like the image I loaded
for example on sheet 2 I have this:

so I am expecting something like

but without those empty spots like 5 or 7 etc.
start point to display this table is A92
and be able to count "zeros"
the original code work good counting the values in one column
but now when I tried to count in one row, then I got trouble.
so let me show you the original code

Sub Freq_ML()
Dim freqs(), xxx As Range
On Error Resume Next
Set xxx = Application.InputBox("Select the cell you want to process", "Location of souce data", Default:="$H$2:$H$2800", Type:=8) 'would be nice to avoid input box
On Error GoTo 0
If xxx Is Nothing Then
  MsgBox "Aborted"
  Exit Sub
End If
vals = xxx.Value
vmax = Application.Max(vals)
vmin = Application.Min(vals)
bin = Evaluate("row(A" & vmin & ":A" & vmax & ")")
freqs = Application.WorksheetFunction.Frequency(vals, bin)
ReDim Preserve freqs(1 To UBound(freqs), 1 To 2)
For i = 1 To UBound(bin)
  freqs(i, 2) = bin(i, 1)
Next i
For i = 2 To UBound(bin)
  For j = UBound(bin) To i Step -1
    If freqs(j, 1) < freqs(j - 1, 1) Then
      temp1 = freqs(j, 1): temp2 = freqs(j, 2)
      freqs(j, 1) = freqs(j - 1, 1): freqs(j, 2) = freqs(j - 1, 2)
      freqs(j - 1, 1) = temp1: freqs(j - 1, 2) = temp2
    End If
  Next j
Next i
i = 1
ColCount = 0
Do
  myMax = 1
  ColCount = ColCount + 1
  Do
    i = i + 1
    myMax = myMax + 1
  Loop Until freqs(i, 1) <> freqs(i - 1, 1)
  If myMax > Max Then Max = myMax
Loop Until i >= UBound(bin)
Dim Results()
ReDim Results(1 To Max, 1 To ColCount + 1)
i = 1: c = 1
Do
  r = 1
  Results(r, c) = freqs(i, 1)
  r = r + 1
  Do
    Results(r, c) = freqs(i, 2)
    r = r + 1
    i = i + 1
  Loop Until freqs(i, 1) <> freqs(i - 1, 1)
  c = c + 1
Loop Until i > UBound(bin)
Dim Destn As Range
On Error Resume Next
Set Destn = Application.InputBox("Select the cell where do you want the results", "Location of result table", Type:=8)' location to display A92
On Error GoTo 0
If Destn Is Nothing Then
  MsgBox "Aborted"
Else
  Destn.Resize(UBound(Results), UBound(Results, 2)).Value = Results
  Application.Goto Destn
End If
End Sub

Beside I really don't want input boxes,
I would like fix input and output.

Thank you Marc for your time.

 

[Marc L]

​

Use the XL2BB forum tool to attach your worksheet or better link a sample workbook on a files host website like Dropbox for example …​

 

[montecarlo2012]

Microsoft OneDrive

1drv.ms

one drive

 

[Marc L]

​

On my side it crashes on the previous codeline : freqs = Application.WorksheetFunction.Frequency(vals, bin) 'cause of variable bin in error …​

​

So first I prefer to know what you are trying to do, elaborate each step, the source range, the operations, where to place the result …​

 

[montecarlo2012]

Hi, Marc L, thanks for your help, you are right that line is a problem.
I got it now, so I am working now in a new idea.
anyway you ask me 5 questions

what you are trying to do, [frequency]
elaborate each step, [ ]
the source range, [row 2 xlend]
the operations, [count]
where to place the result …[A92]

but I am fine now.
Have a great weekend Marc.