Skip iteration of loop if certain value exists - vba

I have the following code below that iterates through rows of a specific range and if a value is present (code not seen), creates copies of the entire pages. My concern is at the bottom of the code in the iteration of r1. It originally only had one conditional statement...
If BiDiRowValid(r1)
and I wanted to add a second conditional statement, which I did...
and Range("MAIN_BIDI_PINMC") <> "No BiDi"
but when I run the code and the MAIN_BIDI_PINMC range = "No BiDi", it errors out and doesn't get past that line. FYI: IsBiDiRowValid() is a function that checks to see that the specific r1 is not empty, and then continues. Right after that subroutine finishes and exits, my code errors with a "Type Mismatch error". I also added the ElseIf line at the bottom, I have not gotten to that code because the top errors out, but I just want to make sure I am writing this iteration correctly, and if anything else needs to be done. Basically, if "NoBiDi" is found in the range, I want it to skip all of this code and go to the next r1... which is what I think I have written... Thanks in advance!
Private Sub start_new()
Dim MC_List As Range
Dim r1 As Range
Dim biDiPinName As Range
Dim Pin As String
Dim mc As String
Dim mType As String
Dim tabName As String
Dim rowNumber As Integer
Dim pinmcSplit() As String
Dim NoBidi As String
On Error GoTo start_biDi_tr_new_Error
Set MC_List = Range("MAIN_PINMC_TABLE")
Set biDiPinName = Range("MAIN_PIN2_NAME")
For Each r1 In MC_List.Rows
If IsBiDiRowValid(r1) And WorksheetFunction.CountIf(Worksheets("MAIN").Range("MAIN_BIDI_PINMC", "No Bidi") = 0 Then
tabName = r1.Cells(1, 8)
pinmcSplit = Split(tabName, "_")
Pin = pinmcSplit(0)
mc = pinmcSplit(1)
mType = r1.Cells(1, 3)
ElseIf WorksheetFunction.CountIf(Worksheets("MAIN").Range("MAIN_BIDI_PINMC"), "No Bidi") = 1 Then
End If
Next

You are getting that error because Range("MAIN_BIDI_PINMC") is not a single cell. To check for a value in multiple cells you can use Application.Worksheetfunction.Countif
EDIT
Post discussion in chat, the user wanted to loop through each cell.
Dim aCell As Range
For Each r1 In MC_List.Rows
If IsBiDiRowValid(r1) Then
For Each aCell In Worksheets("MAIN").Range("MAIN_BIDI_PINMC")
If aCell.Value <> "No Bidi" Then
tabName = r1.Cells(1, 8)
pinmcSplit = Split(tabName, "_")
Pin = pinmcSplit(0)
mc = pinmcSplit(1)
mType = r1.Cells(1, 3)
End If
Next
ElseIf aCell.Value = "No Bidi" Then
'~~> Do Something
End If
Next

Related

# VALUE Error while executing UDF VBA Function on formatted cells

I wrote the following function to check if the prerequisites for my Excel row are satisified.
Public Function PREREQUISITESOK(prerequisites As Range) As String
Dim cw As Worksheet
Dim prerequisite_cell As Range
Dim prerequisite_cell_txt As String
Dim training_id_cell As Range
Dim no_groups_cell_to_compare As Range
Dim no_groups_cell_to_check As Range
Dim training_id_cell_txt As String
Dim training_id_cell_row_n As Integer
Dim n As Integer
Application.Volatile
PREREQUISITESOK = "OK"
Set cw = Sheets("4c.Trainings OSS")
Set training_id = cw.Range("$B$11:$B$34")
Set no_groups_cell_to_compare = cw.Range("J" & CStr(prerequisites.Row))
For Each prerequisite_cell In prerequisites.Cells
prerequisite_cell_txt = prerequisite_cell.Text
If prerequisite_cell_txt = "" Then
Exit For
Else
For Each training_id_cell In training_id.Cells
training_id_cell_txt = training_id_cell.Text
If training_id_cell_txt = prerequisite_cell_txt Then
training_id_cell_row_n = training_id_cell.Row
Set no_groups_cell_to_check = cw.Cells(training_id_cell_row_n, no_groups_cell_to_compare.Column)
If no_groups_cell_to_check.Value < no_groups_cell_to_compare.Value Then
PREREQUISITESOK = "NOT OK"
Exit Function 'It is enough for us that one prerequisite is not satisfied so we can exit the function
Else
PREREQUISITESOK = "OK"
End If
Exit For 'Training IDs are unique so if we find the right Training ID then we may exit the loop
End If
Next training_id_cell
End If
Next prerequisite_cell
End Function
Note that the prerequisites range is inline formatted.
The function that I wrote is supposed to return String value so I completely do not understand why am I getting #VALUE! error.
What is interesting that if I clear formatting from the prerequisites cells that are used as arguments of the function then #VALUE! error disappears.
Do you have any idea why this happens?

EXCEL VBA , Search Line Error 1004

I am trying to run an excel vba form to search through the lines, but for some unknown reason I get the error:
Method Range of object Global failed
Private Sub CommandButton3_Click()
Dim last, i As Integer
Dim ref, lote As String
'Sheets("analisegeral").Visible = True
Sheets("analisegeral").Select
last = Range("analisegeral").End(xlUp).Row + 1
For i = 2 To last ref = Cells(i, 8)
lote = Cells(i, 13)
If TextBox1.Text = ref Then
TextBox2.Text = lote
GoTo fim
End If
Next i
If TextBox1.Text <> ref Then
TextBox2.Text = ""
MsgBox "Referência não encontrada!", vbInformation
TextBox1.Text = ""
TextBox2.Text = ""
GoTo fim
End If
fim:
End Sub
There are few issues with your code.
Invalid declaration
Dim last, i As Integer
Dim ref, lote As String
Note that last and ref are declared as Variant type here, unless it was your intent, change it to following:
Dim last As Integer, i As Integer
Dim ref As String, lote As String
Failing to activate worksheet where range is located
'Sheets("analisegeral").Visible = True
Sheets("analisegeral").Select
The fact that your sheet is hidden (or very hidden) disallows it's selection.
Probably this is the case of your error.
Wrong method of calculating last row number
last = Range("analisegeral").End(xlUp).Row + 1
Given you will actualy select analisegeral sheet, this still doesn't make sense:
Range("NamedRange") is a construction that allows to refer to previously named range (either with VBA or manualy). Unless you have one, this will raise another error. Perhaps you meant something like this?
last = Range("A" & Rows.Count).End(xlUp).Row
This will give you a number of column A last row.
Final advice: avoid using Select

Simple cipher in VBA in Excel using a table for substitution

I want to write a simple cipher in Excel which would take a text from a cell, substitute each letter for a number from adjacent column and then put the output in another cell. Can't get VLOOKUP to work - it works as a formula, but somehow can't get it to work inside VBA code. Tried to do a simple procedure first that would do this for one character (adding a loop later would be easy), but it doesn't work. It compiles, but when I run it (press a button I assigned it to) I get "#N/A" in the result cell.
Sub Zakoduj()
Dim Literka As String
Dim Liczba As Variant
Dim ColumnToTake As Integer
ColumnToTake = 1 ' Liczby
On Error Resume Next
Err.Clear
Literka = Sheets("Sheet2").Range("B2").Value
Liczba = Application.VLookup(Literka, Sheets("Sheet1").Range("A5:B39"), ColumnToTake, False)
If Err.Number = 0 Then
Sheet2.Range("B6").Value = Liczba
Else
Sheet2.Range("B6").Value = Err.Number
End If
End Sub
The range contains number and characters as follows:
Kod Litera
16 A
73 B
12 C
40 D
70 E
etc. etc.
Couldn't find a tutorial that would explain how to do this...
Here is a modified version. Note that the values are in A1:B6 on sheet 1
Option Explicit
Sub Zakoduj()
Dim Literka As Integer
Dim Liczba As String
Dim ColumnToTake As Integer
ColumnToTake = 2 ' Liczby
Literka = Sheets("Sheet2").Range("B2").Value
Liczba = "Value not found" 'If value is not found
On Error Resume Next
Liczba = Application.WorksheetFunction.VLookup(Literka, Sheets("Sheet1").Range("A1:B6"), ColumnToTake, False)
On Error GoTo 0 'Always reset error handling after On Error Resume Next
Sheet2.Range("B6").Value = Liczba
End Sub

Why is assigning the Value property of cell causing code to end aburptly?

Private Sub FillRow(programCell As Range, storedProgramCell As Range)
Dim counter As Integer
For counter = 3 To 9
Dim cellOffset As Integer
cellOffset = counter - 3
Dim currentStoredCell As Range
Set currentStoredCell = storedProgramCell.Offset(0, cellOffset)
Dim value As String
value = currentStoredCell.value
Dim currentTargetCell As Range
Set currentTargetCell = programCell.Offset(0, cellOffset)
MsgBox currentStoredCell.value 'Works correctly, prints correct value
currentTargetCell.value = value
Next counter
End Sub
The line:
currentTargetCell.value = value
causes the code to stop executing, with no error.
I added the expression to my watch list, then stepped through the routine. The expression was seen as a Boolean:
This makes me think the expression is being viewed as a comparison, and the program abruptly ends since the returned Boolean is not being stored or used anywhere. I wouldn't doubt if I were wrong though.
I'm new to VBA, struggling to debug my program, so please forgive me if this is a petty mistake. I couldn't find any sources online that explains this problem.
Replace your subroutine with following code:
Private Sub FillRow(Dst As Range, Src As Range)
Dim x As Integer
Dim v As Variant
Dim Srcx As Range
Dim Dstx As Range
Debug.Print "FillRow"
Debug.Print Src.Address
Debug.Print Dst.Address
Debug.Print "Loop"
For x = 0 To 6
Debug.Print x
Set Srcx = Src.Offset(0, x)
Debug.Print Srcx.Address
v = Srcx.Value
Debug.Print TypeName(v)
Set Dstx = Dst.Offset(0, x)
Debug.Print Dstx.Address
Dstx.Value = v
Next
Debug.Print "Completed"
End Sub
Run and post in your question Immediate window output.
Value is a reserved word, even if vba does not raise an error on this name, you should not use it. Name it something else. Also, try setting it as a variant.

Unexplained Type Mismatch error at about every 10,000 iterations in Excel VBA

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!).