I have been struggling for a while to try and implement a goal-seek function in VBA, but with no results, which is why I am turning to you guys.
I have a Variant of double-values, where the last element is just a temporary set value, which would have to be changed (as in goalseek) so that the sum of the entire array equals to 1. Of course this is exactly what you would do in a worksheet, but I need it in VBA, handling NO cells...
Is there a way to call the Goalseek function in VBA without having to use a worksheet (or cells), and instead just working with variables?
Thanks,
Niklas
If it's only about filling the last array item then this code might come in handy:
Sub FillLastElementWithDifferenceToOne()
Dim arr As Variant
Dim i As Integer, sum As Double
ReDim arr(1 To 10)
'Fill Array with .01 - .09
For i = LBound(arr) To UBound(arr)
arr(i) = i / 100
Next i
'Calculate sum = .45
For i = LBound(arr) To UBound(arr) - 1
sum = sum + arr(i)
Next i
'Set last item of array
arr(UBound(arr)) = 1 - sum
'Clean up
Set arr = Nothing
End Sub
Otherwise please specify what exactly you want to accomplish with VBA and where the problems are and post the code where the problems occur.
Related
I have declared an array as such Dim rArray() As Variantbut when i try and use the values that is stored in it (as shown below) I get a subscript out of range error. The UBound(rArray)and LBound(rArray) both returns values 14 and 1, but the error occurs at the Debug.Print line.
If I use the for statement as below
For Each rArr in rArray
then it works without issues, but for the purposes I am creating this array I need the flexibility to select each item stored in that order- meaning I need to refer to them using subscripts.
I have tried multiple ways to try and solve this with no luck and spend almost half my day on this one issue. Could anyone point out what I need to change to get this to work.
Set rng = Range("D4", Range("D4").End(xlDown))
rng.NumberFormat = "0"
rArray = rng.Value
For x = UBound(rArray) To LBound(rArray) Step -1
Debug.Print rArray(x)
Next x
Edit: another fact worth mentioning is that he array is declared and used within a Function but it is not passed from or to the function. Can't arrays be declared and used in Functions?
When you assign worksheet values to a variant array, you always end up with a 2-D array that is 1 based (e.g. 1 to something, 1 to something; never 0 to something, 0 to something). If you are getting values from a single column the second Rank is merely 1 to 1.
This can be proven with the following.
Dim x As Long, rArray As Variant, rng As Range
Set rng = Range("D4", Range("D4").End(xlDown))
rng.NumberFormat = "0" 'don't really understand why this is here
rArray = rng.Value
Debug.Print LBound(rArray, 1) & ":" & UBound(rArray, 1)
Debug.Print LBound(rArray, 2) & ":" & UBound(rArray, 2)
For x = UBound(rArray, 1) To LBound(rArray, 1) Step -1
Debug.Print rArray(x, 1)
Next x
So you need to ask for the element in the first rank of the array; it is insufficient to just ask for the element.
Hello I am trying to get the MIN and MAX values from the array and it always returns "0" despite anything. My code:
Dim MachineCapacitySmallestArray() As Variant
MachineCapacitySmallestArray = thisworkbook.worksheets(1).range("C25:D25")
SmallestCapacity = Application.Min(MachineCapacitySmallestArray)
in range I have natural numbers
I tried formatting those cells to numbers etc. but nothing works. What is the mistake I'm making and how to fix it?
According to the comments, it seems that your problem is your data, you have likely strings in your cell, not numbers (maybe somehow imported?)
As already mentioned, changing the cell format doesn't change the content of a cell, it just defines how to display data. The number 3.14 can be displayed as 3, as 3.140000, as 00003.14 or as 3.14E+00, nothing changes it's value. However, a String '3.14 is a combination of the characters 3, ., 1 and 4 and has nothing to do with a number. Setting a cell format after the value is in the cell will not convert it to a number.
If you read your data into VBA, VBA will get the exact values from Excel and in your case, you will have to convert it into numbers manually, for example with the following routine. The On Error Resume Next will prevent a type mismatch if a cell doesn't contain something that can be converted into a number.
Sub ArrToNumber(ByRef arr)
Dim i As Long, j As Long
For i = LBound(arr, 1) To UBound(arr, 1)
For j = LBound(arr, 2) To UBound(arr, 2)
On Error Resume Next
arr(i, j) = CDbl(arr(i, j))
On Error GoTo 0
Next
Next
End Sub
Now just add a call to this routine to your code. If you want to have the numbers also in Excel, remove the comment sign from the last statement.
Dim MachineCapacitySmallestArray() As Variant
MachineCapacitySmallestArray = thisworkbook.worksheets(1).range("C25:D25")
ArrToNumber MachineCapacitySmallestArray
SmallestCapacity = Application.Min(MachineCapacitySmallestArray)
' thisworkbook.worksheets(1).range("C25:D25") = MachineCapacitySmallestArray
Sub FWP()
Dim i As Integer
Dim j As Integer
Dim n As Integer
n = Range("A1").Value
For i = 1 To n
For j = 1 To n
If Cells(i + 1, j) = 0 Then
Cells(i + 1, j).Value = Int(((n ^ 2) - 1 + 1) * Rnd + 1)
ElseIf Cells(i + 1, j) <> 0 Then
Cells(i + 1, j).Value = Cells(i + 1, j).Value
End If
Next j
Next i
I am trying to do a part of a homework question that asks to fill in missing spaces in a magic square in VBA. It is set up as a (n x n) matrix with n^2 numbers in; the spaces I need to fill are represented by zeros in the matrix. So far I have some code that goes through checking each individual cell value, and will leave the values alone if not 0, and if the value is 0, it replaces them with a random number between 1 and n^2. The issue is that obviously I'm getting some duplicate values, which isn't allowed, there must be only 1 of each number.
How do I code it so that there will be no duplicate numbers appearing in the grid?
I am attempting to put in a check function to see if they are already in the grid but am not sure how to do it
Thanks
There are a lot of approaches you can take, but #CMArg is right in saying that an array or dictionary is a good way of ensuring that you don't have duplicates.
What you want to avoid is a scenario where each cell takes progressively longer to populate. It isn't a problem for a very small square (e.g. 10x10), but very large squares can get ugly. (If your range is 1-100, and all numbers except 31 are already in the table, it's going to take a long time--100 guesses on average, right?--to pull the one unused number. If the range is 1-40000 (200x200), it will take 40000 guesses to fill the last cell.)
So instead of keeping a list of numbers that have already been used, think about how you can effectively go through and "cross-off" the already used numbers, so that each new cell takes exactly 1 "guess" to populate.
Here's one way you might implement it:
Class: SingleRandoms
Option Explicit
Private mUnusedValues As Scripting.Dictionary
Private mUsedValues As Scripting.Dictionary
Private Sub Class_Initialize()
Set mUnusedValues = New Scripting.Dictionary
Set mUsedValues = New Scripting.Dictionary
End Sub
Public Sub GenerateRange(minimumNumber As Long, maximumNumber As Long)
Dim i As Long
With mUnusedValues
.RemoveAll
For i = minimumNumber To maximumNumber
.Add i, i
Next
End With
End Sub
Public Function GetRandom() As Long
Dim i As Long, keyID As Long
Randomize timer
With mUnusedValues
i = .Count
keyID = Int(Rnd * i)
GetRandom = .Keys(keyID)
.Remove GetRandom
End With
mUsedValues.Add GetRandom, GetRandom
End Function
Public Property Get AvailableValues() As Scripting.Dictionary
Set AvailableValues = mUnusedValues
End Property
Public Property Get UsedValues() As Scripting.Dictionary
Set UsedValues = mUsedValues
End Property
Example of the class in action:
Public Sub getRandoms()
Dim r As SingleRandoms
Set r = New SingleRandoms
With r
.GenerateRange 1, 100
Do Until .AvailableValues.Count = 0
Debug.Print .GetRandom()
Loop
End With
End Sub
Using a collection would actually be more memory efficient and faster than using a dictionary, but the dictionary makes it easier to validate that it's doing what it's supposed to do (since you can use .Exists, etc.).
Nobody is going to do your homework for you. You would only be cheating yourself. Shame on them if they do.
I'm not sure how picky your teacher is, but there are many ways to solve this.
You can put the values of the matrix into an array.
Check if a zero value element exists, if not, break.
Then obtain your potential random number for insertion.
Iterate through the array with a for loop checking each element for this value. If it is not present, replace the zero element.
I wrote a sub to remove the blank entries in a row without shifting the cells around but it seems unnecessarily clunky and I'd like to get some advice on how to improve it.
Public Sub removeBlankEntriesFromRow(inputRow As Range, pasteLocation As String)
'Removes blank entries from inputRow and pastes the result into a row starting at cell pasteLocation
Dim oldArray, newArray, tempArray
Dim j As Integer
Dim i As Integer
'dump range into temp array
tempArray = inputRow.Value
'redim the 1d array
ReDim oldArray(1 To UBound(tempArray, 2))
'convert from 2d to 1d
For i = 1 To UBound(oldArray, 1)
oldArray(i) = tempArray(1, i)
Next
'redim the newArray
ReDim newArray(LBound(oldArray) To UBound(oldArray))
'for each not blank in oldarray, fill into newArray
For i = LBound(oldArray) To UBound(oldArray)
If oldArray(i) <> "" Then
j = j + 1
newArray(j) = oldArray(i)
End If
Next
'Catch Error
If j <> 0 Then
'redim the newarray to the correct size.
ReDim Preserve newArray(LBound(oldArray) To j)
'clear the old row
inputRow.ClearContents
'paste the array into a row starting at pasteLocation
Range(pasteLocation).Resize(1, j - LBound(newArray) + 1) = (newArray)
End If
End Sub
Here is my take on the task you describe:
Option Explicit
Option Base 0
Public Sub removeBlankEntriesFromRow(inputRow As Range, pasteLocation As String)
'Removes blank entries from inputRow and pastes the result into a row starting at cell pasteLocation
Dim c As Range
Dim i As Long
Dim new_array As String(inputRow.Cells.Count - WorksheetFunction.CountBlank(inputRow))
For Each c In inputRow
If c.Value <> vbNullString Then
inputRow(i) = c.Value
i = i + 1
End If
Next
Range(pasteLocation).Resize(1, i - 1) = (new_array)
End Sub
You'll notice that it is quite different, and while it may be slightly slower than your solution, because it is using a for each-loop instead of looping through an array, if my reading of this answer is correct, it shouldn't matter all that much unless the input-range is very large.
It is significantly shorter, as you see, and I find it easier to read - that may just be familiarity with this syntax as opposed to yours though. Unfortunately I'm not on my work-computer atm. to test it out, but I think it should do what you want.
If your main objective is to improve the performance of the code, I think that looking into what settings you may turn off while the code is running will have more effect than exactly what kind of loop and variable assignment you use. I have found this blog to be a good introduction to some concepts to bear in mind while coding in VBA.
I hope you have found my take on your problem an interesting comparison to your own solution, which as others have mentioned should work just fine!
If I am to understand you want to delete blanks and pull the data left on any given row?
I would do it by converting the array to a string joined with pipe |, clean any double pipes out (loop this until there are no doubles left) then push it back to an array across the row:
Here is my code:
Sub TestRemoveBlanks()
Call RemoveBlanks(Range("A1"))
End Sub
Sub RemoveBlanks(Target As Range)
Dim MyString As String
MyString = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(Range(Target.Row & ":" & Target.Row))), "|")
Do Until Len(MyString) = Len(Clean(MyString))
MyString = Clean(MyString)
Loop
Rows(Target.Row).ClearContents
Target.Resize(1, Len(MyString) - Len(Replace(MyString, "|", ""))).Formula = Split(MyString, "|")
End Sub
Function Clean(MyStr As String)
Clean = Replace(MyStr, "||", "|")
End Function
I put a sub to test in there for you.
If you have pipes in your data, substitute it with something else in my code.
I'm trying to store some reference data in a string array and then use that later on to compare with another string array. However, the code is not working since I'm getting a "subscript out of range" error (see code comment below).
Sub StoreBaseReferences()
Dim cell As Range
Dim val As Variant
Dim stringValues() As String
Dim i, rowCounter, columnCounter As Integer
rowCounter = 0
columnCounter = 0
For i = 2 To Sheets("sheet").UsedRange.rows.Count
For Each cell In Range(Cells(i, 2), Cells(i, 4))
stringValues(rowCounter, columnCounter) = cell.Value 'this is throwing the subscript ouf of range error
columnCounter = columnCounter + 1
Next cell
rowCounter = rowCounter + 1
columnCounter = 0
Next i
MsgBox (stringValues(0, 0))
End Sub
What is missing here?
Arrays in VBA need to be dimensioned with the number of elements that are expected to be used. You've defined the dimension, but not specified how many elements will be added to it. Try adding the following line just before the For loop:
ReDim stringValues(Sheets("sheet").UsedRange.Rows.Count, 3)
you are declaring a 1d array Dim stringValues() As String
but trying to use it as a 2d array stringValues(rowCounter, columnCounter)
Also, you are not declaring the size of the array and you are trying to use it. In VBA you have to make sure you tell the size of the array at the declaration time.
To delcare the count of elements that the array is capable of storing
Dim stringArray(0 to 10) or Dim stringArray(10)
and when iterating the counter starts at 0.
Using ReDim stringValues() allows you to resize the bounds at a later stage.
The topic is too broad to go over in one answer so check out the links to learn out how to dimension your array
VBA arrays
Array in Excel VBA