Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 6 years ago.
Improve this question
Hi I want to generate n random numbers in VBA so that their sum must be 100 and they must be placed in such a way that 7 numbers come on first row then next 7 on second row and so on. I have tried so many solutions given on internet but nothing works for me. So anyone can suggest a solution or give me a link for the solution.
Thanks in advance.
Say we want to make 10 numbers that sum to 100. In A1 enter:
=RANDBETWEEN(1,50)
and in A2 enter:
=IFERROR(RANDBETWEEN(1,100-SUM($A$1:A1)),0)
copy A2 down through A10:
EDIT#1:
To use a macro, try:
Sub randomality()
Dim ary(1 To 10) As Double, zum As Double
Dim i As Long
Randomize
zum = 0
For i = 1 To 10
ary(i) = Rnd
zum = zum + ary(i)
Next i
For i = 1 To 10
ary(i) = ary(i) / zum
Next i
With Application.WorksheetFunction
For i = 1 To 10
Cells(i, "D").Value = Round(100 * ary(i), 0)
Next i
Cells(10, "D").Value = 100 - .Sum(Range("D1:D9"))
End With
End Sub
This puts the values in D1 through D10
The below code will do what you have asked but you have more questions you need to check over: -
Public Sub Sample()
Dim AryNumbers() As Long
Dim LngCounter As Long
ReDim AryNumbers(0)
Randomize
Do Until LngCounter = 100
AryNumbers(UBound(AryNumbers, 1)) = Int(10 * Rnd + 1)
If (LngCounter + AryNumbers(UBound(AryNumbers, 1))) > 100 Then
AryNumbers(UBound(AryNumbers, 1)) = 100 - LngCounter
Else
LngCounter = LngCounter + AryNumbers(UBound(AryNumbers, 1))
ReDim Preserve AryNumbers(UBound(AryNumbers, 1) + 1)
End If
Loop
End Sub
You didn't specify where the numbers are to be stored or if the are to be whole numbers, I have provided them in whole numbers in an array to answer the question.
You need to consider who random the number is, if you looked on the internet you'll know this is a difficult question
I honoured the extra requirement in the comments section of being between 1 and 10.
Related
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 5 years ago.
Improve this question
I have a column in my excel in the following format:
Column A
1.2kg
100ml
2m
200
I need to run the VBA to split the numbers and text separately into two columns as:
Column A | Column B
1.2 | kg
100 | ml
2 | m
200 |
I've also found a similar question in this site, however it isn't work for my VBA. Can anyone help me on this?
PS. I use excel 2007
Untested as am on mobile. Does it do what you want?
Option Explicit
Sub SplitValuesUnits()
' Code assumes values are on Sheet1. Change sheet name as needed.'
With thisworkbook.worksheets("Sheet1")
Dim LastRow as long
LastRow = .cells(.rows.count,"A").end(xlup).row
With .range("A1:B" & LastRow)
Dim ArrayOfValues() as variant
ArrayOfValues = .value2
Dim CharacterIndex as long
Dim RowIndex as long
For RowIndex = lbound(ArrayOfValues,1) to ubound(ArrayOfValues,1)
' Skip zero-length strings, as well as values which are already numbers and do not need splitting '
If len(ArrayOfValues(RowIndex,1)) <> 0 then
If not isnumeric(ArrayOfValues(RowIndex,1)) then
Dim CurrentValue as string
CurrentValue = ArrayOfValues(RowIndex,1)
' Loop through string backwards until we find a numeric value, at which point we assume there are no further non-numeric characters. '
For CharacterIndex = Len(CurrentValue) to 1 Step -1
If isnumeric(mid$(CurrentValue),CharacterIndex,1)) then exit for
Next CharacterIndex
If CharacterIndex >= 1 then
ArrayOfValues(RowIndex,1) = cdbl(left$(CurrentValue,CharacterIndex))
ArrayOfValues(RowIndex,2) = mid$(CurrentValue,CharacterIndex + 1)
End if
End if
End if
Next RowIndex
' Overwrite two columns with values. '
.value2 = arrayofvalues
End with
End with
End sub
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 6 years ago.
Improve this question
How to create a combination generator where order does not matter but being limited from a specific range of Sum? Using Excel VBA macro. Pls help ive been trying to solve this for years not really good at excel vba.. need actual precise codes..
Here is a very simple example that uses an incrementing binary pattern to generate combinations of a set of items.
The items can be either numbers or text values. I am using column B as a "helper column" to hold the binary pattern, but an array could be substituted.Place your items in column A and run this short macro:
Sub Generate()
Dim i As Long, s As String
Dim j As Long, K As Long, N As Long
Dim wf As WorksheetFunction
Dim answer As String
Set wf = Application.WorksheetFunction
K = 1
N = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To (2 ^ N) - 1
s = wf.Dec2Bin(i, N)
For j = 1 To N
Cells(j, 2).Value = Val(Mid(s, j, 1))
Next j
answer = ""
For j = 1 To N
If Cells(j, 2) = 1 Then answer = answer & "," & Cells(j, 1)
Next j
Cells(K, 3) = Mid(answer, 2)
K = K + 1
Next i
End Sub
For example:
Because there are (2^N)-1 combinations for N items, there is a practical limit to the number of items that can be placed in column A.
Closed. This question is not reproducible or was caused by typos. It is not currently accepting answers.
This question was caused by a typo or a problem that can no longer be reproduced. While similar questions may be on-topic here, this one was resolved in a way less likely to help future readers.
Closed 6 years ago.
Improve this question
I am new to VBA and coding in general.
I was trying my best to create a little VBA to help me automatically sum the rows of a table.
In my code, I have bolded the output. ie. after i click the macro, the sum is supposed to show and it is also supposed to be bolded.
However,I am not sure where I went wrong. :o Whenever I run, there is nothing seen.
I have tried to solve it by myself but it finds fault with the
.Cells(j, 1stCol + 1)
for both lines. I am not sure if there are any other faults because I cannot troubleshoot this myself.
Could anybody kindly help?
Also, does anybody have any good books to read up more on VBA? The internet confuses me quite a lot of the time I am trying to learn.
Thank you all for your help!
here is my code.
Option Explicit
Sub addHorizontalSums()
Dim lstCol As Integer
With Excel.ThisWorkbook.Sheets("Sheet1")
lstCol = .Cells(1, .Columns.Count).End(Excel.xlToLeft).Column
Dim j As Integer
For j = 1 To .Cells(1, .Columns.Count).End(Excel.xlToLeft).Column
.Cells(j, 1stCol + 1) = "=SUM(RC[-" & lstCol - 1 & "]:RC[-1])"
.Cells(j, 1stCol + 1).Font.Bold = True
Next j
End With
End Sub
This is an update...
Davesexcel,
The formula you gave I think only works if all the rows are the same length, however, if they arent, it will cut the data in half based on the first row found. I need to be able to calculate rows of different lengths.
The updated code you gave doesnt work too well. If you look at the Note Column, there are like many gaps of different gap spaces and the latest formula always results in debug message, without being fully calculated.
Is there a way for me to SUM all the numbers in each little sub-table BUT only subtracting the last no. Eg. if there are 9 items in a list with the 10th being the subtotal, is there code to SUM the 9 and then subtract the 10th, to give an overall result of 0?
Lastly, is it possible to highlight all the data that is being churned out, say in yellow? This would help me do the recording down quickly.
Thanks guys for all of your help!
Appreciated with much thanks! :)
First, you probably meant to write lstCol instead of 1stCol in the For-loop.
Second, if I get you right you want to show the sum of each row after the last cell in each row. If so, the variable j must go from 1 to the number of rows used on your sheet, not the number of columns. The following code should do the task.
Sub addHorizontalSums()
Dim j As Integer
Dim lstCol As Integer
With Excel.ThisWorkbook.Sheets("Sheet1")
lstCol = .Cells(1, .Columns.Count).End(Excel.xlToLeft).Column
For j = 1 To .Cells(1, 1).End(xlDown).Row
.Cells(j, lstCol + 1) = "=SUM(RC[-" & lstCol - 1 & "]:RC[-1])"
.Cells(j, lstCol + 1).Font.Bold = True
Next j
End With
End Sub
As a remark, you might want to use a different way to determine lstCol in case you have different numbers of entries in each row. You could for example use the following code, which I think should be more robust:
Sub addHorizontalSums()
Dim j As Integer
With Excel.ThisWorkbook.Sheets("Sheet1")
For j = 1 To .Cells(1, 1).End(xlDown).Row
.Rows(j).End(xlToRight).Offset(0, 1).Value = Application.WorksheetFunction.Sum(Rows(j))
.Rows(j).End(xlToRight).Font.Bold = True
Next j
End With
End Sub
You are limiting the number of rows to equal the number of columns, you should count the columns and rows separately.
For example,(change 1 to 2 in the rng,if you want it to start on row 2)
Sub Button2_Click()
Dim LstCol As Long, LstRw As Long, Rng As Range, Sh As Worksheet
Set Sh = Sheets("Sheet1")
With Sh
LstCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
LstRw = .Cells(.Rows.Count, LstCol).End(xlUp).Row
Set Rng = .Range(.Cells(1, LstCol + 1), .Cells(LstRw, LstCol + 1))
End With
With Rng
.Formula = "=SUM(RC[-" & LstCol & "]:RC[-1])"
.Font.Bold = 1
.Value = .Value 'use if you only want to show values, not formula
End With
End Sub
Sum between blanks
Before
After
Sub SumBetweenBlanks()
Dim RangeArea As Range, x As Long
x = Cells(1, Columns.Count).End(xlToLeft).Column
For x = 1 To x
For Each RangeArea In Columns(x).SpecialCells(xlCellTypeConstants, 1).Areas
With RangeArea.Offset.End(xlDown).Offset(1)
.Value = Application.Sum(RangeArea)
.Font.Bold = 1
End With
Next RangeArea
Next x
End Sub
This question already has an answer here:
Why is 134.605*100 not equal 13460.5 in VBA Access? [duplicate]
(1 answer)
Closed 8 years ago.
Sorry for not giving more detailed title, but it is because of this special case. My google search did not give me any similar topic.
The following simple code should give a series of numbers from 0.1 to 10 with step 0.1 (I hoped at least) in column A:
Cells(1, 1) = 0.1
For i = 2 To 100
Cells(i, 1) = Cells(i - 1, 1) + 0.1
Next i
Until 5.9 it works well, but after that the result is not as expected:
instead of 6 I get 5,99999999999999
instead of 6.1 I get 6,09999999999999
instead of 6.2 I get 6,29999999999999
...
Could anyone explain what is wrong with the code or why I get this result?
Thanks!
Or simply this?
Sub Sample()
Dim i As Long
For i = 1 To 100
'~~> Change Sheet1 to respective sheet
ThisWorkbook.Sheets("Sheet1").Cells(i, 1) = i * 0.1
Next i
End Sub
Or like this
Sub Sample()
'~~> Change Sheet1 to respective sheet
With ThisWorkbook.Sheets("Sheet1").Range("A1:A100")
.Formula = "=Row()*.1"
.Value = .Value
End With
End Sub
Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
Closed 8 years ago.
This question appears to be off-topic because it lacks sufficient information to diagnose the problem. Describe your problem in more detail or include a minimal example in the question itself.
Questions asking for code must demonstrate a minimal understanding of the problem being solved. Include attempted solutions, why they didn't work, and the expected results. See also: Stack Overflow question checklist
Improve this question
Let me give you a basic understanding of my what I'm trying to do. I have two workbooks: Master Workbook and Workbook A. Information in Workbook A will be inputted into the Master Workbook. In Workbook A, there is Column X with numbers between the ranges of 1 to 25. All I care about are values greater than 14.
Problem: How do I create a VBA function that looks at Column X (Row 1) to see if it is greater than 14? If it is then it copies the entire row and pastes it into the Master Workbook, else it moves onto Column X2. Also, after copying row 1 and pasting into Master Workbook, I also need it to go back to Workbook A and check the rest of Column X if it is greater 14.
Thank you so much in advance!
This code should do what you want:
Private Sub checkAndCopy()
Dim i As Integer
Dim lastRow As Integer
Dim foundItem As String
Dim j As Integer
Dim pasteTo As Range
Dim k As Integer
k = 0
lastRow = WorksheetFunction.CountA(Range("A:A"))
For i = 1 To lastRow
If Cells(i, 24).Value > 14 Then
k = k + 1
For j = 1 To 24
foundItem = Cells(i, j).Value
Set pasteTo = Workbook(yourWorkbook).Cells(k, j)
pasteTo.Value = foundItem
Next j
End If
Next i
End Sub
Note that it copies into the new workbook starting on Row 1. You can have it search for the next empty line and add to that by including:
k = Workbook(yourWorkbook).WorksheetFunction.CountA(Range("A:A")) + 1
I hope this helps!