My code is running perfectly until get to "If c = "" Then". At this point the run time error '-2147418113 (8000ffff)': Automation Error is raised. I have put an On Error Resume Next statement to check if everything goes right if I skip this line and it does. I really don't understand what this error means and I wasn't able to find useful information about it. Could someone bring light to this problem? I have tried to change "If c = "" Then" to "If len(c.value)=0 Then" but it raises the same error. All the variables in AddresRawDataFile are defined as public (as range) and they were set to range in a different module, called PublicVariable, which is called by every procedure.
Private Sub CommandButton3_Ok_Click()
Dim MsgAlert As String
Dim MsgBoxAlert As Variant 'Message box for for many checks done below
Dim c As Variant 'Variable used in a for each structure
Dim AddressRawDataFile As Variant 'Array of variables with address in Box2_UPb_Options
'Code to assign values from Box2_UPb_Options to the related variables
AddressRawDataFile = Array(RawHg202Range, RawPb204Range, RawPb206Range, RawPb207Range, RawPb208Range, RawTh232Range, RawU238Range, _
RawHg202Header, RawPb204HeaderRange, RawPb206HeaderRange, RawPb207HeaderRange, RawPb208HeaderRange, RawTh232HeaderRange, _
RawU238HeaderRange)
'All of the above variables must not be = ""
For Each c In AddressRawDataFile
'On Error Resume Next
If c = "" Then
MsgBoxAlert = MsgBox("There are one or more addresses missing in Start-AND-Options sheet. " & _
"Please, check it.", vbOKOnly, "Missing Address")
Load Box2_UPb_Options
Box2_UPb_Options.MultiPage1.Value = 2
Box2_UPb_Options.Show
End If
Next
As the items named RawHg202Range etc are actually Range objects then you should use Is Nothing to check if they are empty:
AddressRawDataFile = Array(RawHg202Range, RawPb204Range, RawPb206Range, RawPb207Range, RawPb208Range, RawTh232Range, RawU238Range, _
RawHg202Header, RawPb204HeaderRange, RawPb206HeaderRange, RawPb207HeaderRange, RawPb208HeaderRange, RawTh232HeaderRange, _
RawU238HeaderRange)
For Each c In AddressRawDataFile
If c Is Nothing Then
Related
I am trying to build a code that will help me populate a list with the team names based on 2 different tables in another worksheet.
The code actually runs quite well for the first 10 cells, and then I suddenly get a Runtime error 13 "Type mismatch" and I cannot figure what is wrong with it
the code I have is
Sub populateteam()
Dim wsAkasaka As Worksheet
Dim wsList As Worksheet
Set wsAkasaka = ThisWorkbook.Worksheets("Akasaka")
Set wsList = ThisWorkbook.Worksheets("All Japan")
Dim consultant As String
Dim manager As String
Dim team As String
consultant = wsAkasaka.Range("b" & (ActiveCell.Row)).Value
manager = Application.VLookup(consultant, wsList.Range("a13:c200"), 3, False)
team = Application.VLookup(manager, wsList.Range("E2:F11"), 2, False)
If IsEmpty(ActiveCell.Value) Then
ActiveCell.Value = team
ActiveCell.Offset(1, 0).Select
End If
End Sub
If anyone could give me a light for why this is happening and how could I fix it.
Edit
I forgot to write I get the error on the "team" declaration,
I took it out and ran the code populating with "manager" and had no problem with it, but when I ask for the team I get the error
The issue is that you define your variables As String and if your VLookup returns an error (in case VLookup doesn't find anything), this error cannot be cast into a String and you get a Mismatch Error.
Therefore I recommend the following:
' your code here …
Dim consultant As String
consultant = wsAkasaka.Range("b" & (ActiveCell.Row)).Value
Dim manager As Variant
manager = Application.VLookup(consultant, wsList.Range("a13:c200"), 3, False)
If IsError(manager) Then ' check if consultant was found, if not exit
MsgBox "Consultant """ & consultant & """ not found."
Exit Sub
End If
Dim team As Variant
team = Application.VLookup(manager, wsList.Range("E2:F11"), 2, False)
If IsError(team) Then ' check if manager was found, if not exit
MsgBox "Manager """ & manager & """ not found."
Exit Sub
End If
' your code here …
as a newcomer to VBA any help would be appreciated. The basic point of my program is to loop through columns of the spreadsheet and count the number of non-blank cells in each column, within a specified range.
Here is an example of what my spreadsheet looks like.
1
2
3
1
thing
2
thing
3
thing
When all the cells in the column are blank, VBA throws out a 1004 error, no cells found. What I want to do is say, if a 1004 error occurs, set the count of the non-blank cells (nonBlank = 0) equal to zero, and if no error occurs, count normally. In something like Python, I'd use try/except. Here is my attempt.
For i = 1 To 3
On Error Resume Next
Set selec_cells = Sheet1.Range(Sheet1.Cells(FirstRow, i), Sheet1.Cells(LastRow, i)).SpecialCells(xlCellTypeVisible).Cells.SpecialCells(xlCellTypeConstants)
If Err.Number <> 1004 Then
nonBlank = 0
Else
nonBlank = selec_cells.Count
End If
On Error GoTo -1
Next i
My issue is, when I run this code, it spits out 0 every time, even though column 2 should return 3. Thank you!
Edit: selec_cells is what throws out the error.
Error Handling
There is no On Error Goto -1 in VBA, it's a VB thing (those are links to different pages). A tip would be if you google VBA stuff, just put VBA in front of what you're looking for.
When using On Error Resume Next (defer error trapping), you should 'apply' it on a line or two maximally and 'close' with On Error Goto 0 (disable error trapping) or with another error handler.
Your usage of On Error Resume Next is unacceptable because in this particular case we can test the range: 1. defer error handling, 2. try to set the range, 3. disable error handling. If there was an error the range will not be set hence If Not rg Is Nothing Then which could be translated to something like 'If rg Is Something Then' (double negation) or If a reference to a range has been created Then.
The second solution illustrates a case where the main error handler is handling all errors except the SpecialCells error which has its own error handler. Resume Next means continue with the line after the line where the error occurred. Note the Exit Sub line and note Resume ProcExit where the code is redirected to a label.
The following illustrates two ways how you could handle this. At this stage, I would suggest you use the first one and remember to use the 'closing' On Error Goto 0 whenever you use On Error Resume Next (a line or two).
The Code
Option Explicit
Sub testOnErrorResumeNext()
Const FirstRow As Long = 2
Const LastRow As Long = 11
Dim rg As Range ' ... additionally means 'Set rg = Nothing'.
Dim nonBlank As Long ' ... additionally means 'nonBlank = 0'.
Dim j As Long
For j = 1 To 3 ' Since it's a column counter, 'j' or 'c' seems preferred.
' Since you're in a loop, you need the following line.
Set rg = Nothing
On Error Resume Next
Set rg = Sheet1.Range(Sheet1.Cells(FirstRow, j), _
Sheet1.Cells(LastRow, j)).SpecialCells(xlCellTypeVisible) _
.Cells.SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If Not rg Is Nothing Then
nonBlank = rg.Cells.Count
Else
' Since you're in a loop, you need the following line.
nonBlank = 0
End If
Debug.Print nonBlank
Next j
End Sub
Sub testOnError()
On Error GoTo clearError
Const FirstRow As Long = 2
Const LastRow As Long = 11
Dim rg As Range ' ... additionally means 'Set rg = Nothing'.
Dim nonBlank As Long ' ... additionally means 'nonBlank = 0'.
Dim j As Long
For j = 1 To 3 ' Since it's a column counter, 'j' or 'c' seems preferred.
' Since you're in a loop, you need the following line.
Set rg = Nothing
On Error GoTo SpecialCellsHandler
Set rg = Sheet1.Range(Sheet1.Cells(FirstRow, j), _
Sheet1.Cells(LastRow, j)).SpecialCells(xlCellTypeVisible) _
.Cells.SpecialCells(xlCellTypeConstants)
On Error GoTo clearError
If Not rg Is Nothing Then
nonBlank = rg.Cells.Count
End If
Debug.Print nonBlank
Next j
ProcExit:
Exit Sub ' Note this.
SpecialCellsHandler:
' Since you're in a loop, you need the following line.
nonBlank = 0
Resume Next
clearError:
MsgBox "Run-time error '" & Err.Number & "': " & Err.Description
Resume ProcExit
End Sub
My preference is, wherever possible, to encapsulate the line of code that may cause an error in its own function. The function returns true or false to indicate whether or not there is an error and an out parameter is used to return the value that you want.
This keeps the error testing confined within a very short well defined function.
Sub ttest()
Dim mySheet As Excel.Worksheet
Set mySheet = ThisWorkbook.Sheet1
Dim myIndex As Long
Dim myNonBlank as long
For myIndex = 1 To 3
If AllCellsAreBlank(mySheet.Range(ThisWorkbook.Sheet1.Cells(myFirstRow, myIndex), mySheet.Cells(myLastRow, myIndex)), myIndex, mySelectCells) Then
myNonBlank = 0
Else
myNonBlank = mySelectCells.Count
End If
Next
End Sub
Public Function AllCellsAreBlank(ByRef ipRange As Excel.Range, ByVal ipIndex As Long, ByRef opSelectCells As Range) As Boolean
On Error Resume Next
set opSelectCells = ipRange.SpecialCells(xlCellTypeVisible).Cells.SpecialCells(xlCellTypeConstants)
AllCellsAreBlank = Err.Number <> 0
On Error GoTo 0
End Function
For reference the prefixes I use are
ip: for an input only parameter
iop: for an input parameters that will be changed by the method
op: for a parameter only used to return a value
my: any variable declared within a Method.
I's also suggest you acquire the habit of meaningful descriptive names, myRow, myCol are much more meaningful than i,j, and of ensuring you use fully qualified references rather than the implicit use of the activesheet.
I am getting a Compile Object Required when running a .Find on the following.
Data has been generated from a form and the code is within the form.
I have highlighted in blue where I get the error.
Dim MODATT As String
Dim SearchRange As Range
Dim searchcell As String
Dim NewModShort As String
Dim MakeVal As String
Dim ModVal As String
Dim mdAtt As String
Private Sub ADDPROD_Click()
Worksheets("SKU List").Activate
SKUNUMBER = Range("A1").End(xlDown).Value + 1
Range("A1").End(xlDown).Offset(1).Value = SKUNUMBER
MODATT = Make.Value & " " & Model.Value & " " & PS.Value & "PS"
With Worksheets("Model Att").Range("A1", Range("A1").End(xlDown))
Set mdAtt = .Find(What:=MODATT, LookIn:=xlValues)
If mdAtt Is Nothing Then
Range("A1").End(xlDown).Offset(1).Value = MODATT
MODATT.PutInClipboard
MsgBox "Please add " & MODATT & "to the Model Attributes (This has been copied, ready to paste)", , "Add Attribute"
ModShort
Else
ModShort
End If
End Sub
Set mdAtt = gets the error:
Compile Error: Object Required
A few notes:
As #Dean stated, you have mdAtt declared as a String. Declare is as a Range. Then using the set statement will work as Range is an object.
Try to declare variables where they are used and indent your code. This would make your code easier to follow and debug.
SKUNUMBER is never declared (at least in the code you provided). Use Option Explicit to help prevent this.
Your With block is missing an End With which will give you a compile error.
Your call to ModShort is at the end of your If as well as in your Else statement. Why not just removed the Else and run this after your If statement is complete?
If mdAtt Is Nothing Then
' ...
End If
ModShort
I keep having an issue with some code in VBA Excel was looking for some help!
I am trying to sort through a list of names with corresponding phone numbers, checking for multiple names under the same phone number. Then post those names to a separate sheet.
So far my code is:
Sub main()
Dim cName As New Collection
For Each celli In Columns(3).Cells
Sheets(2).Activate
On Error GoTo raa
If Not celli.Value = Empty Then
cName.Add Item:=celli.Row, Key:="" & celli.Value
End If
Next celli
On Error Resume Next
raa:
Sheets(3).Activate
Range("a1").Offset(celli.Row - 1, 0).Value = Range("a1").Offset(cName(celli.Value) - 1, 0).Value
Resume Next
End Sub
When I try to run the code it crashes Excel, and does not give any error codes.
Some things I've tried to fix the issue:
Shorted List of Items
Converted phone numbers to string using cstr()
Adjusted Range and offsets
I'm pretty new to all this, I only managed to get this far on the code with help from other posts on this site. Not sure where to go with this since it just crashes and gives me no error to look into. Any ideas are appreciated Thank you!
Updated:
Option Explicit
Dim output As Worksheet
Dim data As Worksheet
Dim hold As Object
Dim celli
Dim nextRow
Sub main()
Set output = Worksheets("phoneFlags")
Set data = Worksheets("filteredData")
Set hold = CreateObject("Scripting.Dictionary")
For Each celli In data.Columns(3).Cells
On Error GoTo raa
If Not IsEmpty(celli.Value) Then
hold.Add Item:=celli.Row, Key:="" & celli.Value
End If
Next celli
On Error Resume Next
raa:
nextRow = output.Range("A" & Rows.Count).End(xlUp).Row + 1
output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
'data.Range("B1").Offset(celli.Row - 1, 0).Value = Range("B1").Offset(hold
Resume Next
End Sub
Update2:
Used hold.Exists along with an ElseIf to remove the GoTo's. Also changed it to copy and paste the row to the next sheet.
Sub main()
Set output = Worksheets("phoneFlags")
Set data = Worksheets("filteredData")
Set hold = CreateObject("Scripting.Dictionary")
For Each celli In data.Columns(2).Cells
If Not hold.Exists(CStr(celli.Value)) Then
If Not IsEmpty(celli.Value) Then
hold.Add Item:=celli.Row, Key:="" & celli.Value
Else
End If
ElseIf hold.Exists(CStr(celli.Value)) Then
data.Rows(celli.Row).Copy (Sheets("phoneFlags").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0))
'output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
End If
Next celli
End Sub
When developing code, don't try (or be afraid of) errors as they are pointers to help fix the code or the logic. As such, don't use On Error unless it is absolutely indicated in the coding algorithm (*). using On Error when not necessary only hides errors, does not fix them and when coding it is always better to avoid the errors in the first place (good logic).
When adding to the Dictionary, first check to see if the item already exists. The Microsoft documentation notes that trying to add an element that already exists causes an error. An advantage that the Dictionary object has over an ordinary Collection object in VBA is the .exists(value) method, which returns a Boolean.
The short answer to your question, now that I have the context out of the way, is that you can first check (if Not hold.exists(CStr(celli.Value)) Then) and then add if it does not already exist.
(*) As a side note, I was solving an Excel macro issue yesterday which took me most of the day to nut out, but the raising of errors and the use of debugging code helped me make some stable code rather than some buggy but kind-of-working code (which is what I was fixing in the first place). However, the use of error handling can be a short cut in some instances such as:
Function RangeExists(WS as Worksheet, NamedRange as String) As Boolean
Dim tResult as Boolean
Dim tRange as Range
tResult = False ' The default for declaring a Boolean is False, but I like to be explicit
On Error Goto SetResult ' the use of error means not using a loop through all the named ranges in the WS and can be quicker.
Set tRange = WS.Range(NamedRange) ' will error out if the named range does not exist
tResult = True
On Error Goto 0 ' Always good to explicitly limit where error hiding occurs, but not necessary in this example
SetResult:
RangeExists = tResult
End Function
I have a dynamically defined named range in my excel ss that grabs data out of a table based on a start date and an end date like this
=OFFSET(Time!$A$1,IFERROR(MATCH(Date_Range_Start,AllDates,0)-1,MATCH(Date_Range_Start,AllDates)),1,MATCH(Date_Range_End,AllDates)-IFERROR(MATCH(Date_Range_Start,AllDates,0)-1,MATCH(Date_Range_Start,AllDates)),4)
But if the date range has no data in the table, the range doesn't exists (or something, idk). How can I write code in VBA to test if this range exists or not?
I have tried something like
If Not Range("DateRangeData") Is Nothing Then
but I get "Runtime error 1004, method 'Range' of object '_Global' failed."
Here is a function I knocked up to return whether a named range exists. It might help you out.
Function RangeExists(R As String) As Boolean
Dim Test As Range
On Error Resume Next
Set Test = ActiveSheet.Range(R)
RangeExists = Err.Number = 0
End Function
You can replicate the match in your VBA to count before using the range how many rows you would have, or you can use error handling:
On Error Resume Next
Debug.Print range("DateRangeData").Rows.Count
If Err = 1004 Then
MsgBox "Range Empty"
Exit Sub
Else
MsgBox "Range full"
End If
Err.Clear
On Error GoTo 0
This is another approach. It has the advantage to take the container and the name you want to test. That means you can test either Sheets Names or Workbook Names for example.
Like this:
If NamedRangeExists(ActiveSheet.Names, "Date") Then
...
Else
...
End If
or
If NamedRangeExists(ActiveWorkbook.Names, "Date") Then
...
Else
...
End If
Public Function NamedRangeExists(ByRef Container As Object, item As String) As Boolean
Dim obj As Object
Dim value As Variant
On Error GoTo NamedRangeExistsError:
value = Container(item)
If Not InStr(1, CStr(value), "#REF!") > 0 Then
NamedRangeExists = True
End If
Exit Function
Exit Function
NamedRangeExistsError:
NamedRangeExists = False
End Function
Depending on the application you're doing, it's good to consider using a Dictionary. They're especially useful when you wanna check whether something exists.
Take this example:
Dim dictNames as Scripting.Dictionary
Sub CheckRangeWithDictionary()
Dim nm As Name
'Initially, check whether names dictionary has already been created
If Not dictNames Is Nothing Then
'if so, dictNames is set to nothing
Set dictNames = Nothing
End If
'Set to new dictionary and set compare mode to text
Set dictNames = New Scripting.Dictionary
dictNames.CompareMode = TextCompare
'For each Named Range
For Each nm In ThisWorkbook.Names
'Check if it refers to an existing cell (bad references point to "#REF!" errors)
If Not (Strings.Right(nm.RefersTo, 5) = "#REF!") Then
'Only in that case, create a Dictionary entry
'The key will be the name of the range and the item will be the address, worksheet included
dictNames(nm.Name) = nm.RefersTo
End If
Next
'You now have a dictionary of valid named ranges that can be checked
End Sub
Within your main procedure, all you need to do is do an existence check before using the range
Sub CopyRange_MyRange()
CheckRangeWithDictionary
If dictNames.exists("MyRange") then
Sheets(1).Range("MyRange").Copy
end if
End Sub
While loading the dictionary may look a little longer, it's extremely fast to process and search. It also becomes much simpler to check whether any named range referring to a valid address exists, without using error handlers in this simple application.
Please note that when using names at sheet level rather than workbook level, it is necessary to use more elaborate keys to guarantee uniqueness. From the way the dictionary was created, if a key is repeated, the item value is overwritten. That can be avoided by using the same Exists method as a check in the key creation statement. If you need a good reference on how to use dictionaries, use this one.
Good luck!
This is an old post, but none of the rated answers has a dynamic solution to test if a name exists in a workbook or worksheet. This function below will accomplish that:
Function pg_Any_Name(thename As String) As Boolean
Dim n As Name, t As String
For Each n In ThisWorkbook.Names
t = Mid(n.Name, InStr(1, n.Name, "!", vbTextCompare) + 1, 999)
If UCase(thename) = UCase(t) Then
pg_Any_Name = True
Exit Function
End If
Next n
End Function
Worth noting that this would not have worked for this specific question because OP had a dynamic defined range. This question would have been more accurately titled Test if Name is a Valid Range because the name always existed as a formula, the issue was if it was a valid RANGE. To address this question with a solution that checks both workbook and sheets... this function would work:
Function PG_Range_Name(thename As String) As Boolean
Dim n As Name, t As String
For Each n In ThisWorkbook.Names
t = Mid(n.Name, InStr(1, n.Name, "!", vbTextCompare) + 1, 999)
If UCase(thename) = UCase(t) Then
On Error Resume Next
PG_Range_Name = n.RefersToRange.Columns.Count > 0
Exit Function
End If
Next n
End Function