**News Alert:**Experts Exchange Confirmed as Safe in Cloudbleed Leak Read More

Solved

Posted on 2004-04-19

Hello Everyone

Actually I'm working to extend existing Excel Add-ins, so im working with VBA(nice uh?).

Now I try to explain the project that I divide in two part, the first that i have already done and the second where my troubles begins.

What I need is to write a tool that based on specific criteria(ex: depending of the value in the rows) search for a certain values in all the cells for each column (I need to search in the cell for the string "DR1") then for each column, counting how many cells contain this value, then calculate the 25% of the total of cell founded and round it to the next greater value (ex:I found 4 cell containing "DR1" the 25% is = 1).

This was is the frist part of the problem that I have already coded without any great difficulty.

Now comes the second part that I'm stuck with.

So far what I have is something that loops trough the rows and columns, does some checks, add values to a counter, does some math and give me the result.

Now, I know what is the 25% of the result per column of the total of the values founded, but what I need now is using this value as a reference that set the number of cells that have to be selected from the cells founded for each column,but the selection has to be randomized.(ex: I found 8 cell in the column that contain the string "DR1" the 25% is 2, I have to randomly select 2 of these 8 cells in the column), I mean random like the selection has to be the randomized, not simply select the first two.

This is my problem... how to randomize the selections of the cells that have to be selected?This has to be done for each column(counting the cells, calculate the 25%, select at random the number of cell based on the percent.)

I said that I have to select the cells but what I really have to do is not really a selection but I have to leave the original color only for this cells and for the rest of cells (there is other cell with other values inside with different color) assign a grey color, but this is a part of code that I think I can do by myself without problem.

I hope that you guys have understand the problem and same good soul can help me.

Thnx in advance.

Regards

- dario -

This is the code that I wrote so far.

Sub Random_25()

ActiveSheet.Unprotect

CountPatientVisit LastPatientRow, LastVisitColumn

Dim site As String

Dim count

Dim roundCount

site = InputBox(prompt:="Enter the name of the site")

If site = "" Then Exit Sub

For j = 3 To LastVisitColumn

If Worksheets("Visit Patterns").Cells(3, j) = "0" Then

Dim rnd100

Dim rnd25

rnd100 = j + 1

rnd25 = j + 2

End If

Next

For j = rnd25 To LastVisitColumn

count = 0

For i = 3 To LastPatientRow

If (Worksheets("Summary").Cells(i, "A").Value = site) Then

If Worksheets("Summary").Cells(i, j).Value = "DR1" Then

count = count + 1

'MsgBox Worksheets("Summary").Cells(i, j).Value & " Col: " & j & " - " & count

End If

End If

Next

roundCount = Round(count * 0.25)

MsgBox " The 25% pecent of the total of: " & count & " DR1 in Column: " & j & " = " & roundCount

Next

End Sub

Sub CountPatientVisit(LastPatientRow, LastVisitColumn)

Application.ScreenUpdating = False

MorePatients = True

LastPatientRow = 0

RowIndex = 3

While (MorePatients)

If Worksheets("Summary").Cells(RowIndex, 2) <> "" Then

LastPatientRow = RowIndex

RowIndex = RowIndex + 1

Else

MorePatients = False

End If

Wend

MoreVisits = True

LastVisitColumn = 0

columnindex = 3

While (MoreVisits)

If Worksheets("Visit Patterns").Cells(2, columnindex) <> "" Then

LastVisitColumn = columnindex

columnindex = columnindex + 1

Else

MoreVisits = False

End If

Wend

End Sub

Actually I'm working to extend existing Excel Add-ins, so im working with VBA(nice uh?).

Now I try to explain the project that I divide in two part, the first that i have already done and the second where my troubles begins.

What I need is to write a tool that based on specific criteria(ex: depending of the value in the rows) search for a certain values in all the cells for each column (I need to search in the cell for the string "DR1") then for each column, counting how many cells contain this value, then calculate the 25% of the total of cell founded and round it to the next greater value (ex:I found 4 cell containing "DR1" the 25% is = 1).

This was is the frist part of the problem that I have already coded without any great difficulty.

Now comes the second part that I'm stuck with.

So far what I have is something that loops trough the rows and columns, does some checks, add values to a counter, does some math and give me the result.

Now, I know what is the 25% of the result per column of the total of the values founded, but what I need now is using this value as a reference that set the number of cells that have to be selected from the cells founded for each column,but the selection has to be randomized.(ex: I found 8 cell in the column that contain the string "DR1" the 25% is 2, I have to randomly select 2 of these 8 cells in the column), I mean random like the selection has to be the randomized, not simply select the first two.

This is my problem... how to randomize the selections of the cells that have to be selected?This has to be done for each column(counting the cells, calculate the 25%, select at random the number of cell based on the percent.)

I said that I have to select the cells but what I really have to do is not really a selection but I have to leave the original color only for this cells and for the rest of cells (there is other cell with other values inside with different color) assign a grey color, but this is a part of code that I think I can do by myself without problem.

I hope that you guys have understand the problem and same good soul can help me.

Thnx in advance.

Regards

- dario -

This is the code that I wrote so far.

Sub Random_25()

ActiveSheet.Unprotect

CountPatientVisit LastPatientRow, LastVisitColumn

Dim site As String

Dim count

Dim roundCount

site = InputBox(prompt:="Enter the name of the site")

If site = "" Then Exit Sub

For j = 3 To LastVisitColumn

If Worksheets("Visit Patterns").Cells(3, j) = "0" Then

Dim rnd100

Dim rnd25

rnd100 = j + 1

rnd25 = j + 2

End If

Next

For j = rnd25 To LastVisitColumn

count = 0

For i = 3 To LastPatientRow

If (Worksheets("Summary").Cel

If Worksheets("Summary").Cell

count = count + 1

'MsgBox Worksheets("Summary").Cell

End If

End If

Next

roundCount = Round(count * 0.25)

MsgBox " The 25% pecent of the total of: " & count & " DR1 in Column: " & j & " = " & roundCount

Next

End Sub

Sub CountPatientVisit(LastPati

Application.ScreenUpdating

MorePatients = True

LastPatientRow = 0

RowIndex = 3

While (MorePatients)

If Worksheets("Summary").Cell

LastPatientRow = RowIndex

RowIndex = RowIndex + 1

Else

MorePatients = False

End If

Wend

MoreVisits = True

LastVisitColumn = 0

columnindex = 3

While (MoreVisits)

If Worksheets("Visit Patterns").Cells(2, columnindex) <> "" Then

LastVisitColumn = columnindex

columnindex = columnindex + 1

Else

MoreVisits = False

End If

Wend

End Sub

2 Comments

The way I would do it is with a RND() function. Basically:

Count the number of cells in the selected range. Lets say intSelect = 8.

Select the first cell by using the RND function:

intRndCell = Round((Rnd() * intSelect ) + 1) '<--------- This will give you an random number between 1 and 8

Now in a loop get the intRndCell. I would use a For Next loop with a counter. Once the counter equals intRndCell, that would be the cell you want.

Run through the process again to get the next cell. You will need to refigure the number of cells in the range to exclude the cell already selected.

If you put together some code for this, I would be more than happy to help you finish this.

Leon

generate the random numbers many as is the 25% of the total of values from a range from 1 to the total of values founded then i put the random number in an array.Now i don't know what to do for the last step that is pick only the number of cells that represent the 25% of the total of cells that contain the value that i search in random order and for these cells mantain the original color for all the others cell i have to change the color in grey.

here i s the code i wrote so far with more comments.

Thnx in advance

Sub Random_25()

ActiveSheet.Unprotect

'Call function that return rows and column bounds

CountPatientVisit LastPatientRow, LastVisitColumn

Dim site As String

Dim totalMatch

Dim quarterTotal

'site = InputBox(prompt:="Enter the name of the site")

site = "3/Beilan"

'site = "5/Collins"

If site = "" Then Exit Sub

For j = 3 To LastVisitColumn

'find the column position that contain a "0"

If Worksheets("Visit Patterns").Cells(3, j) = "0" Then

Dim rnd25

'add two at this value, because we start our search 2 column after the one with "0"

rnd25 = j + 2

End If

Next

'from this column to the last

For j = rnd25 To LastVisitColumn

totalMatch = 0

'from this row to the last

For i = 3 To LastPatientRow

'if the name of the site is the one that the user entered

If (Worksheets("Summary").Cel

'and the value in the cell is DR1

If Worksheets("Summary").Cell

'add 1 to the counter

totalMatch = totalMatch + 1

'for debugging only

'MsgBox Worksheets("Summary").Cell

End If

End If

Next

'calulate the 25% of the total of DR1 founded and round it

quarterTotal = Round(totalMatch * 0.25)

'for debuging only

MsgBox " The 25% percent of the total of: " & totalMatch & " DR1 in Column: " & j & " = " & quarterTotal

'do this as many time as the calculated 25% value on quarterTotal

For i = 1 To quarterTotal

Dim cellToPick()

'make a dynamic array that store the random numbers of the length of the total

ReDim cellToPick(1 To quarterTotal)

Randomize ' Initialize random-number generator.

cellToPick(i) = Int((totalMatch * Rnd) + 1) ' Generate random values between 1 and totalMatch.

'for debugging only

MsgBox "Cell to pick in column " & j & " is cell number: " & cellToPick(i)

Next

Next

End Sub

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Join the community of 500,000 technology professionals and ask your questions.