I've just started learning VBA, and I've been playing around with a subroutine that would take a random length column of numbers starting at cell A2, and create and output its transpose using application.transpose() somewhere else. This is my code.
Sub boxmatrix()
ActiveWorkbook.ActiveSheet.Select
Dim x()
Dim xt()
Range("A2").Select
ActiveCell.CurrentRegion.Select
n = ActiveCell.CurrentRegion.Rows.Count
ReDim x(1 To n)
ReDim xt(1 To n)
Dim range1 As Range
Dim range2 As Range
Dim range3 As Range
Set range1 = Range("A2").CurrentRegion
Set range2 = Range(Cells(1, 3), Cells(1, n + 2))
x = range1
xt = Application.Transpose(x)
range2.Value = xt
Debug.Print (x(1)) <--- THIS IS WHERE THE ERROR HAPPENS
End Sub
I've created the code that does accomplish those two things, but I've noticed that I can't do anything else, like multiply these two vectors to create a matrix, because my array x() isn't recognized as having numbers??
Any time I try to reference x(#), I get an error, whereas referencing xt(#) works perfectly fine, which is annoying as xt(#) was populated from the numbers supposedly in x(#) in the first place?
Assuming the CurrentRegion for cell A2 is just other cells in column A, then the statement
ReDim x(1 To n)
is creating a Variant array which is one-dimensional, with bounds 1 To n. But your subsequent statement
x = range1
is replacing that variable with a Variant array which is two-dimensional, with the first dimension having bounds 1 To n, and the second dimension having bounds 1 To 1.
So, to access the first row and first (and only) column, you can use:
Debug.Print x(1, 1)
Related
Im trying to write a code which determines whether certain cells are empty or not and then returns a set string.
To go in detail; I was hoping for the code to look into cell B2, determine if it is empty, then go to C2 and determine if it is non-empty. If both were correct in cell B2 it would then input "Correct" and move on in the range. However, my code doesnt seem to work because it just inputs "Correct" in every cell in the loop range.
I have posted my code below; any help would be much appreciated.
Sub Fill_Rows()
Dim X As Range
Let Y = Range("C2")
For Each X In Range("B2:B5000")
If X = "" And Y <> "" Then
X = "Correct"
End If
Y = Y + 1
Next X
End Sub
If you meant to check by each row like (B2 and C2) then (B3 and C3), then you could do it like this.
Sub Fill_Rows()
Dim iRow As Long
For iRow = 2 To 5000
If Cells(iRow, "B").Value = vbNullString And Cells(iRow, "C").Value <> vbNullString Then
Cells(iRow, "B").Value = "Correct"
End If
Next iRow
End Sub
Alternative
Added two solutions:
[1] an example code as close as possible to yours and
[2] an alternative using a datafield array to demonstrate a faster way for bigger data sets.
[1] Example Code close to yours
There is no need to use a second variable Y, all the more as apparently you left it undeclared, which always can cause issues (type mismatches, no range object etc.).
So always use Option Explicit in the declaration head of your code module to force yourself to declare all variable types you are using.
Now you can simply use an offset of 1 column to the existing cell to check the neighbouring cell, too.
Option Explicit ' declaration head of your code module (obliges to declare variables)
Sub Fill_RowsViaRangeLoop()
Dim X As Range, ws As Worksheet
Set ws = ThisWorkbook.Worksheets("MySheet") ' << replace with your sheet name
For Each X In ws.Range("B2:B5000")
If X = "" And X.Offset(0, 1) <> "" Then ' column offset 1 checks next cell in C
X = "Correct"
End If
Next X
End Sub
[2] Example Code using a datafield array
Looping through a bigger range isn't very fast, you can speed up your procedure by
assigning your range values to a variant datafield array v, loop through the received array items correcting found items in column 1 and write it back to sheet.
Option Explicit ' declaration head of your code module (obliges to declare variables)
Sub Fill_RowsViaArray()
Dim v As Variant, i As Long, ws As Worksheet
Set ws = ThisWorkbook.Worksheets("MySheet") ' << replace with your sheet name
' Assign values to a 2-dim array
v = ws.Range("B2:C5000") ' or better: v = ws.Range("B2:C5000").Value2
' Check criteria looping over all rows (=first array dimension)
For i = 1 To UBound(v) ' data field arrays are one-based, i.e. they start with 1
If v(i, 1) = vbNullString And v(i, 2) <> vbNullString Then v(i, 1) = "Correct"
Next i
' Write edited array back to original range (adapt the range size to the array boundaries in both dimensions)
ws.Range("B2").Resize(UBound(v, 1), UBound(v, 2)) = v
End Sub
Further Notes
It's good use to fully qualify your sheet or range references (see e.g. object variable ws)
Each array item is identified by a row and a column index.
As such a datafield array is one based (start indices are 1), the first item in row 1 and column 1 will be referred by v(1,1), in col 2 by v(1,2).
In order to count the number of row items you check the upper boundary of its first dimension) via UBound(v,1) or even shorter via Ubound(v)
In order to count the number of columns you check the upper boundary of its second dimension) via UBound(v,2) (here the argument 2 is necessary!)
A comparation using vbNullString can be preferred in coding to "" as it takes less memory (c.f. #PEH 's answer) .
Looping through two ranges in one variant variable.
I am trying to read two ranges together at the same time using one variant. I have two ranges A and B, and I am combining them. After combining these two ranges, I am using a variant to read it. My variant variable only reading column A and ignoring Column B. Any suggestion what I am doing wrong.
Dim rngText as Range, rngText2 as Range, results as Range, dText
Set rngText = wSheet3.Range(wSheet3.Range("A1"), wSheet3.Cells(Rows.Count, 1).End(xlUp))
Set rngText2 = wSheet3.Range(wSheet3.Range("B1"), wSheet3.Cells(Rows.Count, 2).End(xlUp))
Set results = Union(rngText, rngText2)
dText = results.Value
For i = 1 to Ubound(dText,1)
'other condition here....
Next i
For i = 1 to Ubound(dText,1)
This loop iterates the first dimension of dText, which is declared as an implicit Variant.
dText = results.Value
This assigns the Variant with a 2D array representing the result of the Union operation. Unless a Range is representing a single cell, Range.Value always returns a 2D array.
You need a nested loop to iterate both dimensions of your 2D array.
Dim currentRow As Long
For currentRow = 1 To UBound(dText, 1)
Dim currentCol As Long
For currentCol = 1 To UBound(dText, 2)
' do stuff
Next
Next
Depending on what you're trying to achieve, it might be better to only iterate rows, and have your loop body's logic get the column indices:
Dim currentRow As Long
For currentRow = 1 To UBound(dText, 1)
Debug.Print "Column A: " & dText(currentRow, 1), "Column B: " & dText(currentRow, 2)
Next
Note that the 2D array holds Variant values representing whatever value/type that's held in the cells: if a cell contains a number, the array index will point to some Variant/Double; if a cell contains a string, the array index will point to some Variant/String; if a cell contains an error, the array index will point to some Variant/Error - and that last point is critical: you'll want to validate that the cell value doesn't contain an error before you assume its type and do anything with it (e.g. the above string-concatenation would fail with run-time error 13 / "type mismatch" given a Variant/Error value in either column, because a String can't be compared to or otherwise converted [implicitly or explicitly] to an Error). This would be safer:
Dim currentRow As Long
For currentRow = 1 To UBound(dText, 1)
If Not IsError(dText(currentRow, 1) And Not IsError(dText(currentRow, 2)) Then
Debug.Print "Column A: " & dText(currentRow, 1), "Column B: " & dText(currentRow, 2)
End If
Next
I ended up defining another loop. That's how I did it, before i was trying to do it in one loop but didn't work.
Set rngText = wSheet3.Range(wSheet3.Range("A1"), wSheet3.Cells(Rows.Count, 1).End(xlUp))
Set rngText2 = wSheet3.Range(wSheet3.Range("B1"), wSheet3.Cells(Rows.Count, 2).End(xlUp))
dText = rngText.Value
dText2= rngText2.Value
For i = 1 to Ubound(dText,1)
'do stuff
Next i
'second loop
For ii = 1 to Ubound(dText2,1)
'do stuff
Next ii
This is a very basic question and I'm sure it has been answered but I can't seem to find it elsewhere. I have a portion of vba code that works fine for a single cell. However I want to expand it to work for a range of cells (all within the same column).
Basically its a goalseeking loops that changes a value in the "b" column until the value in the "w" column matches (comes within 99%) the value in the "x" column.
What works:
Sub Goalseeker()
Do Until Range("w32").Value / Range("x32").Value > 0.99
Range("b32").Value = Range("b32").Value - 1
Loop
End Sub
I want to extend this to work for rows 32 to 107.
What I've tried:
Edit: I've made adjustment based on the comments received and tweaked and few things before it worked. If anyone is interested in the process:
Option Explicit
Sub Goalseeker()
Dim i As Integer
Dim targetcell As Double
Dim outputcell As Double
Dim variablecell As Range
For i = 32 To 107
targetcell = Cells(i, "x")
outputcell = Cells(i, "w")
Set variablecell = Range("B" & i)
Do Until outputcell / targetcell > 0.99
variablecell = variablecell - 1
targetcell = Cells(i, "x")
outputcell = Cells(i, "w")
Loop
Next
End Sub
The bit I had to tweak was
Do Until outputcell / targetcell > 0.99
variablecell = variablecell - 1
targetcell = Cells(i, "x")
outputcell = Cells(i, "w")
Loop
Redefining (i apologize if that's the wrong term) targetcell and outputcell was necessary to prevent an infinite loop.
Thanks all. I will work on making this function for relative references instead of absolute.
Few problems here. Change your For i loop to the format For i = x to y not For i = x to i = y
You can refer to targetcell and outputcell as double but the variablecell needs to be a range. And if it's a range it needs Set
You should declare ALL your variables, as below.
And finally, you might want to put in a catch to get out of infinite looping (in case the target never reaches above 0.99 ?)
Sub Goalseeker()
Dim i As Integer
Dim targetcell As Double
Dim outputcell As Double
Dim variablecell As Range
For i = 32 To 107
targetcell = Cells(i, "x")
outputcell = Cells(i, "w")
Set variablecell = Range("B" & i)
Do Until outputcell / targetcell > 0.99
variablecell = variablecell - 1
Loop
Next
End Sub
Consider the following example table:
Use the code below to find the correct values in the "B" column (as shown) in order to minimize the error between the result (next column) and the goal (two columns over).
Option Explicit
Public Sub GoalSeekMyValues()
' Call GoalSeek with inputvalues "B2:B16", having the result
' at column offset 1, and the goal in column offset 2.
' Note that Range("B2").Resize(15, 1) = Range("B2:B16"),
' But I prefer the top cell and row count of this syntax.
GoalSeek Range("B2").Resize(15, 1), 1, 2
End Sub
Public Sub GoalSeek(ByVal variables As Range, ByVal result_offset As Long, ByVal goal_offset As Long)
Dim n As Long, i As Long, pct_error As Double, last_error As Double
'x is the input value (variable)
'y is the result
'g is the goal for y
Dim x As Double, y As Double, g As Double
' Read the number of rows in the input values
n = variables.Rows.Count
Dim r As Range
' Loop through the rows
For i = 1 To n
'Set a range reference at the i-th input cell
Set r = variables.Cells(i, 1)
' Read the value, the result and the goal
x = r.Value
y = r.Offset(0, result_offset).Value
g = r.Offset(0, goal_offset).Value
pct_error = Abs(y / g - 1)
Do
'Set the next value
r.Value = x - 1
' Read the result (assume goal doesn't change)
y = r.Offset(0, result_offset).Value
' Keep last error, and calculate new one
last_error = pct_error
pct_error = Abs(y / g - 1)
' If new error is more than last then exit the loop
' and keep the previous value (with less error).
If pct_error > last_error Then
' Keep last value
r.Value = x
Exit Do
End If
' read the input value
x = r.Value
' Assume inputs must be positive so end the loop
' on zero on negative numbers
Loop Until x <= 0
Next i
End Sub
Your code has lots of points of failure.
Your code might not ever reach a solution and excel will hang (until Ctrl-Break is pressed). I have a hard break when the inputs become zero or negative. Other problems require other ways to tell that there isn't a solution.
The first time the result comes within 1% of the solution might not produce the least error. I solve this by tracking the absolute value of the relative error. Only when the error starts increasing I terminate the loop. This assumes that decreasing the input by one unit will improve the solution (at least initially). If this is not the case the code will fail.
You use absolute referencing (like reading the 12th cell down and 4th across) and that is not very reusable style of programming. I always try to use relative referencing. I start from the top left referenced cell (in this case B2) and move down and right from there using the following methods:
Range("B2").Cells(5,1) - Reference 5th row and 1st column from B2.
Range("B2").Resize(15, 1) - Expand the range to include 15 rows and one column.
Range("B2).Cells(i,1).Offset(0, 3) - From the i-th row use column offset of 3 (meaning the 4th column in the table).
I suggest to use one of the common goal seeking methods (like bisection), or better yet, use the built-in goal seek function
example:
Range("B2").Cells(i,2).GoalSeek Goal:=Range("B2").Cells(i,3).Value, ChangingCell:=Range("B2").Cells(i,1)
I am looping through a range in Excel VBA. I have an IF-Then that checks to see if the a cell contains a number. I then want the address of the cell that contains the number. The problem is my code returns the first cell with a number over and over.
For Each Row in Room.Rows
If IsNumber(Row.Cells(,1)) then
x = (Row.cells(,1))
End If
Next Row
For Each Row in Room.Rows
If WorksheetFunction.IsNumber(range("A" & Row.row)) then
x = range("A" & Row.row).address
// do stuff with x
End If
Next Row
1) don't use variable names that will confuse people (row)
2) in the for each loop example, you don't need to add the .rows ,
considering your named variable 'row' is a row type.
3) Declare all your variables
4) i changed the code with an other approach :
Dim R as Long
Dim Rg as Range
Dim x as String
For R=1 to Room.rows.count
set Rg= Room.cells(r,1)
If IsNumeric(Rg) then
x = Rg.address
// do stuff with x
End If
Next R
set rg= nothing
I am trying move rows of values into a column in Excel. The transpose function works well, but will only move one row at a time. I would like to get a macro that will convert 173 rows of data across three columns into one column. Please see example below.
Thanks in advance for any help.
Rows:
98,058 98,058 98,314
82,362 82,684 83,326
93,410 93,479 93,761
Columns:
98,058
98,058
98,314
82,362
82,684
83,326
93410
93479
93761
The following will load the data from the CurrentRegion of A1 into an array and paste into one column, beginning in A5.
I'm assuming the data is numerical, contiguous and that this is a one-off, rather than an exercise that might have to be repeated on data sets of differing sizes. If your data is not contiguous, or not bound by empty cells, then you can hard code the range instead.
Private Sub transposeRows()
Dim inputRange As Variant
Dim myArray() As Long
Dim x As Long
Dim testCell As Range
'Get the range of data to copy'
Set inputRange = Range("A1").CurrentRegion
'Resize array to fit'
ReDim myArray(inputRange.Count - 1)
'Fill up array with data'
For Each testCell In inputRange
myArray(x) = testCell
x = x + 1
Next testCell
'Fill destination range'
Range("A5:A" & UBound(myArray) + 5) = WorksheetFunction.Transpose(myArray)
End Sub