I don't have much VBA experience at all, but this is what I'm trying to do (code is below):
I have two sheets- one of dies, one of sales. Each sale has a die it comes from, with a many sales to one die relationship. I'd like to loop through all dies, and within that loop loop through all sales, and compare each of the rows to a set of criteria before outputting them.
'All dies have a type and a size. All products have a type and a size. We hope to match them.
Sub searchroute()
Dim x As Integer, y As Integer, z As Integer
x = 0 'for row offset on dies, number
y = 0 'for row offset on sales, item
z = 0 'for later use
Do Until IsEmpty(Worksheets("Dies").a2.Offset(x, 0)) = True
Do Until IsEmpty(Worksheets("Sales").a2.Offset(y, 0)) = True
If Worksheets("Dies").i2.Offset(x, 0) = Worksheets("Sales").c2.Offset(y, 0) Or Worksheets("Dies").i2.Offset(x, 0) = "Any" Then
If Worksheets("Sales").g2.Offset(y, 0) = Worksheets("Dies").j2.Offset(x, 0) Or Worksheets("Dies").j2.Offset(x, 0) = "Any" Then
'then we've got the same type and size, print output to a cell
'should figure out how to append, place the whole list in a single cell
End If
End If
y = y + 1
Loop
x = x + 1
Loop
End Sub
Stepping through this, it pops a 438 error on the first Do Until. I know this is something easy, but my mind is blank.
Thanks in advance for wisdom!
Replace Worksheets("Dies").a2. with Worksheets("Dies").Range("a2").
Same goes for all instances where you are trying to refer to a spcific cell.
Related
I have a macro that so far, adds 4 new table columns to an existing table ("Table1"). Now, I would like the macro to format the 3rd and 4th row as percentage. I would like to include this in the loop already listed in my code. I have tried several different ways to do this. I don't think I quite understand how the UBound function works, but hopefully you can understand what I am trying to do.
I also am unsure if I am allowed to continue to utilize the WITH statement in my nested For loop in regards to me 'lst' variable.
#Jeeped - I'm looking at you for this one again...thanks for basically walking me through this whole project lol
Sub attStatPivInsertTableColumns_2()
Dim lst As ListObject
Dim currentSht As Worksheet
Dim colNames As Variant, r1c1s As Variant
Dim h As Integer, i As Integer
Set currentSht = ActiveWorkbook.Sheets("Sheet1")
Set lst = ActiveSheet.ListObjects("Table1")
colNames = Array("AHT", "Target AHT", "Transfers", "Target Transfers")
r1c1s = Array("=([#[Inbound Talk Time (Seconds)]]+[#[Inbound Hold Time (Seconds)]]+[#[Inbound Wrap Time (Seconds)]])/[#[Calls Handled]]", "=350", "=[#[Call Transfers and/or Conferences]]/[#[Calls Handled]]", "=0.15")
With lst
For h = LBound(colNames) To UBound(r1c1s)
.ListColumns.Add
.ListColumns(.ListColumns.Count).Name = colNames(h)
.ListColumns(.ListColumns.Count).DataBodyRange.FormulaR1C1 = r1c1s(h)
If UBound(colNames(h)) = 2 or UBound(colNames(h)) = 3 Then
For i = UBound(colNames(h), 2) To UBound(colNames(h), 3)
.ListColumns(.ListColumns.Count).NumberFormat = "0%"
End if
Next i
Next h
End With
End Sub
You don't need to nest a second for loop. If you want to set the 3rd and 4th columns to a percentage, you only need to set that when the iteration of the loop (h) is 2 or 3 (remembering that arrays index from 0). You also shouldn't cross arrays for the main loop, and since LBound is in most cases 0 you might as well just use that anyway. Try this:
With lst
For h = 0 To UBound(r1c1s)
.ListColumns.Add
.ListColumns(.ListColumns.Count).Name = colNames(h)
.ListColumns(.ListColumns.Count).DataBodyRange.FormulaR1C1 = r1c1s(h)
If h = 2 or h = 3 Then
.ListColumns(.ListColumns.Count).NumberFormat = "0%"
End if
Next h
End With
To answer the other point in your question, UBound(array) just gives the index of the largest element (the Upper BOUNDary) in the given array. So where you have 50 elements in such an array, UBound(array) will return 49 (zero based as mentioned before). LBound just gives the other end of the array (the Lower BOUNDary), which is generally zero.
I am trying to build Lee-Ready tick test for estimating trade direction from tick data using Excel. I have a dataset containing the trade prices in descending order, and I am trying to build a VBA code that is able to loop over all the 4m+ cells in as efficient manner as possible.
The rule for estimating trade direciton goes as follows:
If Pt>Pt-1, then d=1
If Pt<Pt-1, then d=-1
If Pt=Pt-1, then d is the last value taken by d.
So to give a concrete example, I would like to transform this:
P1;P2;P3;P4
1.01;2.02;3.03;4.04
1.00;2.03;3.03;4.02
1.01;2.02;3.01;4.04
1.00;2.03;3.00;4.04
into this
d1;d2;d3;d4
1;-1;1;1
-1;1;1;-1
1;-1;1;0
0;0;0;0
Fairly straightforward nested loops suffice:
Function LeeReady(Prices As Variant) As Variant
'Given a range or 1-based, 2-dimensional variant array
'Returns an array of same size
'consisiting of an array of the same size
'of trade directions computed according to
'Lee-Ready rule
Dim i As Long, j As Long
Dim m As Long, n As Long
Dim priceData As Variant, directions As Variant
Dim current As Variant, previous As Variant
If TypeName(Prices) = "Range" Then
priceData = Prices.Value
Else
priceData = Prices
End If
m = UBound(priceData, 1)
n = UBound(priceData, 2)
ReDim directions(1 To m, 1 To n) As Long 'implicitly fills in bottom row with 0s
For i = m - 1 To 1 Step -1
For j = 1 To n
current = priceData(i, j)
previous = priceData(i + 1, j)
If current > previous Then
directions(i, j) = 1
ElseIf current < previous And previous > 0 Then
directions(i, j) = -1
Else
directions(i, j) = directions(i + 1, j)
End If
Next j
Next i
LeeReady = directions
End Function
This can be called from a sub or used directly on the worksheet:
Here I just highlighted a block of cells of the correct size to hold the output and then used the formula =LeeReady(A2:D5) (pressing Ctrl+Shift+Enter to accept it as an array formula).
On Edit: I modified the code slightly (by adding the clause And previous > 0 to the If statement in the main loop) so that it can now handle ranges in which come of the columns have more rows than other columns. The code assumes that price data is always > 0 and fills in the return array with 0s as place holders in the columns that end earlier than other columns:
I'm trying to write a function which returns the value of a specific cell located on the same column as the one I give in argument, (lig= row number, col=column number), but everytime I run it, I get an error '1004", here's my code:
Function week(lig As Integer, col As Integer) As Integer
Dim i As Integer
i = 0
Do Until Cells(lig - i, 1) = "Row labels"
i = i + 1
Loop
week = Cells(lig - i, col)
End Function
The line in which the error appears is :
Do Until Cells(lig - i, 1) = "Row labels"
I know that I test the values of cells containing integers before getting to this one, I suspeect a type error, but I can't fix it.
Could anyone please help ?
The error isn't a type error. The problem is that you are trying to access a cell that doesn't exist. Your loop evidently fails to reach a cell that holds the value "Row labels" and eventually tries to access Cells(0,1) -- which triggers error 1004. As to why this is happening -- you haven't provided enough details to say.
I suspect that the value in the cell is actually "Row Labels" or "ROW LABELS" or Row labels " or something else that doesn't actually match exactly. Try this:
Do Until Trim(Ucase(Cells(lig - i, 1))) = "ROW LABELS"
Or if you simply want to stop at row one use this:
Do Until lig - i = 1
i=0 will cause an error as the cells(0,1) does not exist in the sheet. You may also want an exit clause for if your logic is never found as you will get an error when you hit the end of the sheet. if you pass this lig =1 you will also get an error (as lig - i (1-1) would result in 0)so you may also want to handle that scenario
Function week(lig As Integer, col As Integer) As Integer
Dim i As Integer
i = 1'Changed to 1
Do Until Cells(lig - i, 1) = "Row labels"
i = i + 1
if i > 1000000 then exit do 'Exit clause
Loop
if i < 1000000 then
week = Cells(lig - i, col)
else
week = 0'Handle 0's in calling code
end if
End Function
You might like to consider re-writing as follows, which I think is clearer.
Function week(lig As Integer, col As Integer) As Integer
Dim i As Integer
' Thsi function will return 0 if no row with the text is found
week = 0
For i = lig To 1 Step -1
If Cells(i, 1) = "Row labels" Then
week = Cells(i, col)
Exit For
End If
Next i
End Function
' EVEN BETTER USE THIS (or similar)!
Function week(MyCell As Range) As Integer
Dim i As Integer
week = 0
For i = MyCell.Row To 1 Step -1
If MyCell.Parent.Cells(i, 1) = "Row labels" Then
week = MyCell.Parent.Cells(i, MyCell.Column)
Exit For
End If
' Note
' MyCell.Parent. returns the sheet containing the cell
' Just using Cells(i, 1) (wihtout preceeding with "MyCell.Parent." will pick up
' cells on the currently active sheet, which may not be the sheet with the cell!
'
Next i
End Function
I'm trying to teach myself some basic VBA in Excel 2010 and I've come across a problem I can't google myself out of. The objective is to create a button which when pressed, automatically does linest for me and writes the values into an array. So far, this is my code.
Private Sub CommandButton1_Click()
Dim linest As Variant
Dim linestArray(4,1) as Variant
Dim i As Integer, j as Integer
linest = Application.LinEst(Range("U49:U51"), Range("T49:T51"), True, True)
For i = 0 To 4
linestArray(i,0) = accessing values of linest variable fyrst column
Cells(68 + i, 21) = linestArray(i,0)
Next
For j = 0 To 4
linestArray(j,1) = accessing values of linest variable second column
Cells(68 + j, 22) = linestArray(j,0)
Next
End Sub
How do I access the values of variable linest so I can store them to an array and print them? Thank you.
EDIT: I figured it out. Variable linest is already an array! I feel pretty dumb. Sorry, this can be ignored.
New code:
Dim linestArray As Variant
linestArray = Application.LinEst(Range("U49:U51"), Range("T49:T51"), True, True)
For i = 0 To 4
For j = 0 To 1
Cells(68 + i, 21 + j) = linestArray(i + 1, j + 1)
Next
Next
The output of any such formula is a Variant array. So you've got that part right.
For a general approach to these Application. (use WorksheetFunction. instead, it's much faster) type functions is...
Type the function in Excel (as an array formula, Ctrl-Shift-Return, if need be)
The output is an N x M matrix of some sort (N =1 , M =1) for most cases
When you do Var = Application.Linest(xyx), the answer gets stored in Var
Get the size of the Var using Ubound(Var, 1), Ubound(Var, 2) to get number of rows and columns (note that these are base 0 type arrays)
Usually, the size will be one x one. In that case, your variable is stored in Var(0,0) i.e. a zero base multidimensional variant array, the top left element.
Hope this helps.
I have a VBA macro that uses Microsoft MapPoint to calculate the distance between two locations for each record in my spreadsheet. I have about 120,000 records to process. The program runs smoothly for about 10,000 iterations then returns a Type Mismatch error where I define the MapPoint locations in my error handler. At which point, I select 'Debug' and then resume execution without editing any code, and it will run successfully for another 10,000 or so records before the same thing happens again.
I've checked my data, and I can't see why there would be a type mismatch, or for that matter why the code would choke on a record one time, and then, without resetting anything, handle the same record upon resuming. Any idea why this would happen?
For reference,
- column M contains locations of the form "X County, ST"
- column AN contains a separate location as ZIP
- column G contains the same location data as AN but in the form "X County, ST"
Sub distance_from_res()
Dim oApp As MapPoint.Application
Dim k As Long
Dim count As Long
Dim errors As Long
k = 0
count = Sheets("i1_20041").Range("A2", Sheets("i1_20041").Range("A2").End(xlDown)).count
errors = 0
Set oApp = CreateObject("MapPoint.Application.NA.11")
oApp.Visible = False
Set objMap = oApp.NewMap
Dim objRes As MapPoint.Location
Dim objFish As MapPoint.Location
'Error executes code at 'LocError' and then returns to point of error.
On Error GoTo LocError
Do While k < count
If Sheets("i1_20041").Range("M2").Offset(k, 0) <> "" Then
'Sets MapPoint locations as [County],[State] from Excel sheet columns "INT_CNTY_ST" and "ZIP".
Set objRes = objMap.FindResults(Sheets("i1_20041").Range("AN2").Offset(k, 0)).Item(1)
Set objFish = objMap.FindResults(Sheets("i1_20041").Range("M2").Offset(k, 0)).Item(1)
'Calculates distance between two locations and prints it in appropriate cell in Column AO.
Sheets("i1_20041").Range("AO2").Offset(k, 0) = objRes.DistanceTo(objFish)
Else
errors = errors + 1
End If
k = k + 1
Loop
'Displays appropriate message at termination of program.
If errors = 0 Then
MsgBox ("All distance calculations were successful!")
Else
MsgBox ("Complete! Distance could not be calculated for " & errors & " of " & count & " records.")
End If
Exit Sub
LocError:
If Sheets("i1_20041").Range("G2").Offset(k, 0) = "" Then
errors = errors + 1
Else
'THIS IS WHERE THE ERROR OCCURS!
Set objRes = objMap.FindResults(Sheets("i1_20041").Range("G2").Offset(k, 0)).Item(1)
Set objFish = objMap.FindResults(Sheets("i1_20041").Range("M2").Offset(k, 0)).Item(1)
'Calculates distance between two locations and prints it in appropriate cell in Column AO.
Sheets("i1_20041").Range("AO2").Offset(k, 0) = objRes.DistanceTo(objFish)
End If
k = k + 1
Resume
End Sub
UPDATE:
I incorporated most of the suggestions from #winwaed and #Mike D, and my code is now more accurate and doesn't choke on errors. However, the old problem reared its head in a new form. Now, after around 10,000 iterations, the code continues but prints the distance of the ~10,000th record for every record afterwards. I can restart the code at the trouble point, and it will find the distances normally for those records. Why would this happen? I've posted my updated code below.
Sub distance_from_res()
Dim oApp As MapPoint.Application
Dim k As Long
Dim rc As Long
Dim errors As Long
Dim dist As Double
Dim zipRes As Range
Dim coRes As Range
Dim coInt As Range
Dim distR As Range
Set zipRes = Sheets("Sheet1").Range("C2")
Set coRes = Sheets("Sheet1").Range("B2")
Set coInt = Sheets("Sheet1").Range("E2")
Set distR = Sheets("Sheet1").Range("G2")
k = 0
rc = Sheets("Sheet1").Range("F2", Sheets("Sheet1").Range("F2").End(xlDown)).Count
errors = 0
'Start MapPoint application.
Set oApp = CreateObject("MapPoint.Application.NA.11")
oApp.Visible = False
Set objMap = oApp.NewMap
Dim objResultsRes As MapPoint.FindResults
Dim objResultsInt As MapPoint.FindResults
Dim objRes As MapPoint.Location
Dim objInt As MapPoint.Location
Do While k < rc
'Check results for Res Zip Code. If good, set first result to objRes. If not, check results for Res County,ST. If good, set first result to objRes. Else, set objRes to Nothing.
Set objResultsRes = objMap.FindResults(zipRes.Offset(k, 0))
If objResultsRes.ResultsQuality = geoFirstResultGood Then
Set objRes = objResultsRes.Item(1)
Else
Set objResultsRes = Nothing
Set objResultsRes = objMap.FindResults(coRes.Offset(k, 0))
If objResultsRes.ResultsQuality = geoFirstResultGood Then
Set objRes = objResultsRes.Item(1)
Else
If objResultsRes.ResultsQuality = geoAmbiguousResults Then
Set objRes = objResultsRes.Item(1)
Else
Set objRes = Nothing
End If
End If
End If
Set objResultsInt = objMap.FindResults(coInt.Offset(k, 0))
If objResultsInt.ResultsQuality = geoFirstResultGood Then
Set objInt = objResultsInt.Item(1)
Else
If objResultsInt.ResultsQuality = geoAmbiguousResults Then
Set objInt = objResultsInt.Item(1)
Else
Set objInt = Nothing
End If
End If
On Error GoTo ErrDist
distR.Offset(k, 0) = objRes.DistanceTo(objInt)
k = k + 1
Loop
Exit Sub
ErrDist:
errors = errors + 1
Resume Next
End Sub
You are constructing a somewhat complex range object (Range -> Offset -> Item). DIM temporary range objects and do it in steps so you can see where exactly the problem occurs
tmpR1 = Sheets("i1_20041").Range("G2")
tmpR2 = tmpR1.Offset(k,0)
then examine the .Count property of the .FindResult before you try accessing Item(1) .... maybe this item doesn't exist ?!?
Debug.Print objMap.FindResult(tmpR2).Count
Hint:
looking at your code, I observe that you use a variable "count". This variable name overlaps with the "Count" property in your second line of code - that's why the "Count" keyword at the end of the statement is printed all lowercase. It's not got anything to do with the errors (we pretend ;-) ), but bad style anyway.
MikeD is right with your dangerous FindResults() calls. However, there is a better way to check the results. The "FindResults collection" isn't a pure collection but includes an extra properties called "ResultsQuality". Docs are here:
http://msdn.microsoft.com/en-us/library/aa493061.aspx
Resultsquality returns a GeoFindResultsQuality enumeration. You want to check for the values geoAllResultsGood and geFirstResultGood. All other results should give an error of some result. Note that your existing code would work find with (for example) Ambiguous Results, even though it is unlikely the first result is the correct one. Also it might match on State or Zipcode (because that is the best it can find) whcih give you an erroneous result. Using ResultsQuality, you can detect this.
I would still check the value of Count as an additional check.
Note that your code is calculating straight line (Great Circle) distances. As such the bottleneck will be the geocoding (FindResults). If you are using the same locations a lot, then a caching mechanism could greatly speed things up.
If you want to calculate driving distances, then there are a number of products on the market for this (yes I wrote two of them!).