I'm looping through a list of items most of which are numbers but occasionally I get a string.
I would like to skip the strings and go to the next row without breaking the loop.
I am defining the numbers as doubles so the strings give me a type mismatch errror.
I think I should be using some sort of IF test but am unsure how to tell VBA to skip the 'wrong' variables.
I have tried using variants to avoid the error but can't find an IF test to tell them apart.
If you want to get only explicit numbers excluding thereby also any text-formatted numbers (NumberFormat = "#"), which would be interpreted as Double anyway, you might code as follows checking for the variable type (VarType) as well as for the NumberFormat:
Sub ExplicitNumbersOnly()
Dim rng As Range
Set rng = Tabelle1.Range("A2:A10")
Dim i As Long
For i = 1 To rng.Rows.Count
Dim currCell As Range: Set currCell = rng.Cells(i, 1)
If VarType(currCell) = vbDouble And currCell.NumberFormat <> "#" Then
Debug.Print "OK:", currCell.Value
'... do something
'...
Else
'Debug.Print "Omitted: " & currCell.Address
End If
Next i
End Sub
Here is a tiny example of explicitly testing each value to see if it is "double compatible":
Sub NumCk()
Dim r As Range, rng As Range, v As Variant, d As Double
Set rng = Range("A1:A10")
For Each r In rng
v = r.Value
On Error Resume Next
d = CDbl(v)
If Err.Number = 0 Then
r.Offset(0, 1) = d / 2
Else
Err.Number = 0
End If
On Error GoTo 0
Next r
End Sub
It will reject a text value like "hello world" but accept a value like "1.2" as a text string.
Related
I've been trying to find/write a macro that opens all hyperlinks contained in a selected range at once. The code I've come across works on only some types of hyperlinks, specifically hyperlinks added through either the right click/Insert>Link/Ctrl+K. The code wont recognise any hyperlinks that are formed using the HYPERLINK() function.
Here's the code I found online:
Sub OpenMultipleLinks()
On Error Resume Next
Set myRange = Application.Selection
Set myRange = Application.InputBox("Range", "OpenMultipleLinks", myRange.Address, Type:=8)
For Each oneLink In myRange.Hyperlinks
oneLink.Follow
Next
End Sub
And here's the formula of a cell that becomes a hyperlink.
=IF($D2="All Charts","",HYPERLINK("http://SubstituteWebsite/ChartId="&$D2&$AF$1,"link"))
Since you do not answer my clarification questions, I will assume that my understanding is correct. So, the following code will work if your formulae containing 'HYPERLINK' formula inside respect the pattern you show us and it should be followed without evaluating if the formula condition is True:
Sub OpenMultipleLinks()
Dim myrange As Range, cel As Range, oneLink
On Error Resume Next
Set myrange = Application.Selection
Set myrange = Application.InputBox("Range", "OpenMultipleLinks", myrange.Address, Type:=8)
For Each oneLink In myrange.Hyperlinks
oneLink.Follow
Next
On Error GoTo 0
For Each cel In myrange
If InStr(cel.Formula, "HYPERLINK") > 0 Then
ActiveWorkbook.FollowHyperlink extractHypFromFormula(ActiveCell.Formula)
End If
Next
End Sub
Function extractHypFromFormula(strForm As String) As String
Dim Hpos As Long, startP As Long, Hlength As Long, strRoot As String
Dim startP2 As Long, cellsAddr As String
Hpos = InStr(strForm, "HYPERLINK") 'it returns position of the first character for "HYPERLINK" string in the formula
If Hpos > 0 Then
startP = Hpos + Len("HYPERLINK") + 2 'it builds the position after which to start searching
'+ 2 because of '(' and "
Hlength = InStr(startP, strForm, """") - startP 'length of the hyperlink fix part (before the strings taken from the two cells value)
strRoot = Mid(strForm, startP, Hlength) 'it returns the hyperlink fix part
startP2 = startP + Len(strRoot) + 2 'next START to return the string keeping the concatenation of the two cells value
cellsAddr = Mid(strForm, startP2, InStr(startP2, strForm, ",") - startP2) 'the string keeping the concatenation of the two cells value
'split the string on "&" separator and use the two elements as range string:
extractHypFromFormula = strRoot & Range(Split(cellsAddr, "&")(0)).value & Range(Split(cellsAddr, "&")(1)).value
End If
End Function
Please, send some feedback after testing it...
You need to parse/evaluate the "hyperlink" formula first. Assuming all your links are in col A this will do what you want:
Sub link()
Dim arr, arr2, j As Long
arr = Sheet1.Range("A1").CurrentRegion.Formula2 'get all in an array
For j = 1 To UBound(arr)
If Left(arr(j, 1), 3) = "=HY" Then 'check if it's a formula
arr(j, 1) = Evaluate(Split(Mid(arr(j, 1), 2), ",")(0) & ")") 'split the url from the rest, evaluate and replace in array
End If
ActiveWorkbook.FollowHyperlink Address:=arr(j, 1), NewWindow:=True 'open in default browser
Next j
End Sub
Best of luck,
ceci
I have a number of named ranges within the scope of my Workbook.
Now I want to loop over each named range by following the second answer of this related topic
Sub Range1()
Dim i As Integer
For i = 2 To ActiveWorkbook.Names.Count
MsgBox ActiveWorkbook.Names(i).Name
Next i
End Sub
This macro shows me all the names such as C_1 in a msgbox. I modify the script in the following way to "call" each of the ranges based on the name of the corresponding range.
Sub Range2()
Dim i As Integer
Dim rng As Range
Dim nm As Name
Dim rng_name As String
For i = 2 To ActiveWorkbook.Names.Count
Set nm = ActiveWorkbook.Names(i)
rng_name = nm.Name
Set rng = Application.Range(nm.Name) `This line yields an error
MsgBox rng.Address
Next i
End Sub
The error I get is:
"Run-time error '1004': Method 'Range' of object'_ Apolication failed
Any idea what I am doing wrong? If I inspect the elements I see that rng_name is equal to "C_1".
EDIT
I believe that it has something to do with how the named ranges are created. This is done in the following way:
Sub createRanges()
Dim LastRowAll As Long, LastRowUnique As Long
Dim x, y
Dim rng As Range
Dim rng_name As String
LastRowUnique = Sheets("Lists").Range("J2").End(xlDown).Row
LastRowAll = Sheets("Deribit").Range("D8").End(xlDown).Row
For Each x In Sheets("Lists").Range("J2:J" & LastRowUnique)
For Each y In Sheets("Deribit").Range("D8:D" & LastRowAll)
If y.Offset(0, -1).value = "Call" Then
If rng Is Nothing And y = x Then
Set rng = y.Offset(0, -2)
ElseIf y = x Then
Set rng = Union(rng, y.Offset(0, -2))
End If
Else:
End If
Next y
rng_name = "C_" & x.Offset(0, -1).value
ThisWorkbook.Names.Add Name:=rng_name, RefersTo:=rng.Address
Set rng = Nothing
Next x
See:
For i = 1 To ActiveWorkbook.Names.Count
Set nm = ActiveWorkbook.Names(i)
Set rng = ActiveWorkbook.Names(nm.Name) 'This is where the error was
MsgBox rng.Address
Next i
I also dropped the rng_name, since you didn't use it.
Edit1:
I was unable to get Application.Range(nm.Name) to work originally, but was able to get ActiveWorkbook.Range(nm.Name) to work, using ranges on different sheets named "c" and "d". I noted that nm = ActiveWorkbook.Names(i) did not include the sheet name when it was recorded.
When naming ranges with the underscore and number in them (I tried c_1 & c_2) I was unable to get my code to work; on inspecting nm in debug mode, I noticed that it also listed the sheet name. I had to specify that than rng would .RefersToRange to get the cell address to show up without the sheet name.
I did two additional checks, one with the underscore without number (used "d_") and another with a number and no underscore (used "name2"), and both did give me the same error. Both scenarios kept the Sheet name in the string nm.
Here is the testing code that I was executing/stepping through to sort that out:
Dim rng As Range, i As Long
For i = 1 To ActiveWorkbook.Names.Count
Set nm = ActiveWorkbook.Names(i)
'Set rng = ActiveWorkbook.Names(nm.Name)
Set rng = nm.RefersToRange
'Debug.Print rng.Address
MsgBox rng.Address
Next i
Using Set rng = nm.RefersToRange worked in all scenarios, while alpha-character only names worked with the Set rng = ActiveWorkbook.Names(nm.Name).
Suggestion, stick with .RefersToRange as the robust code.
I am trying to get the values of the visible cells of a range into an array.
My code makes the array carry the values until the first non visible cell then stops.
Public Function ListeMaschinen() As Variant
Dim Auswahl As Range
With Sheets("qry_TechnischesDatenblatt")
Set Auswahl = .Range(.Range("A2:B2"), .Range("A2:B2").End(xlDown)).SpecialCells(xlCellTypeVisible)
End With
ListeMaschinen = Auswahl
End Function
If I select the range it shows all the cells I want marked.
Auswahl.Select
Here I have added the range cells to an array.
Sub examp()
Dim rng As Range, cll As Range, i As Integer, a(100) As Variant
Set rng = Range(Range("A2:B2"), Range("A2:B2").End(xlDown)).SpecialCells(xlCellTypeVisible)
i = 0
For Each cll In rng
a(i) = cll.Value
i = i + 1
Next
End Sub
In your code, you are setting a Variant variable equal to a Range object without using the Set statement.
The following works with the little testing I did. Of course, if you declare the function type and other variables as Range type, it also works.
Option Explicit
Sub test()
Dim myVar As Variant
Set myVar = myList()
Debug.Print myVar.Address
End Sub
Public Function myList() As Variant
Dim myRng As Range
With Sheets("Sheet1")
Set myRng = .Range(.Range("A1:B1"), .Range("A1:B1").End(xlDown)).SpecialCells(xlCellTypeVisible)
End With
Debug.Print myRng.Address
Set myList = myRng
End Function
I think your issue is related to
.SpecialCells(xlCellTypeVisible)
When I do this:
Public Function ListeMaschinen() As Variant
Dim Auswahl As Range
With Sheets("qry_TechnischesDatenblatt")
Set Auswahl = .Range(.Range("A2:B2"), .Range("A2:B2").End(xlDown)).SpecialCells(xlCellTypeVisible)
End With
MsgBox Auswahl.Address
Set ListeMaschinen = Auswahl
'Auswahl.Select
End Function
I get an Address composed of 2 parts: the visible parts!
But when I remove the SpecialCells
Public Function ListeMaschinen() As Variant
Dim Auswahl As Range
With Sheets("qry_TechnischesDatenblatt")
Set Auswahl = .Range(.Range("A2:B2"), .Range("A2:B2").End(xlDown))
End With
MsgBox Auswahl.Address
Set ListeMaschinen = Auswahl
End Function
I get one single part, which Is what I get when using Select too.
I tested!
Sub test()
Dim myVar As Variant
Dim i As Integer
i = 0
Set myVar = ListeMaschinen()
For Each C In myVar
i = i + 1
MsgBox C.Value & C.Address & "-" & i
Next
End Sub
Further to my comments earlier, here is a method that will work subject to some limitations:
You can't have more than 65536 rows of data; and
You can't have really long text (911 chars+), or blank visible cells; and
The data should not contain the string "|~|"
If those conditions are met, you can use something like this:
Dim v
Dim sFormula As String
With Selection
sFormula = "IF(SUBTOTAL(103,OFFSET(" & .Cells(1).Address(0, 0) & ",row(" & .Address(0, 0) & ")-min(row(" & .Address(0, 0) & ")),1))," & .Address(0, 0) & ",""|~|"")"
End With
Debug.Print sFormula
v = Filter(Application.Transpose(Evaluate(sFormula)), "|~|", False)
You can adapt this to work round the third limitation by changing the alternate text in the formula string.
Hello :) I was trying to find a way to loop through visible rows in a table without going through all the rows and checking if they are visible as this was consuming too much time on a large table. Below is the solution I was able to come up with. It is a function that returns an array of the absolute row numbers of visible rows in a given Range.
Function GetVisibleRows(LookupRange As Range) As Integer()
Dim VisibleRange As Range, Index As Integer, Area As Range
Static VisibleRows() As Integer
Set VisibleRange = LookupRange.SpecialCells(xlCellTypeVisible)
ReDim VisibleRows(0)
Index = 0
For Each Area In VisibleRange.Areas
If Index = 0 Then
VisibleRows(Index) = Area.Row
ReDim Preserve VisibleRows(Index + 1)
End If
Index = UBound(VisibleRows())
If VisibleRows(Index - 1) <> Area.Row Then
VisibleRows(Index) = Area.Row
ReDim Preserve VisibleRows(Index + 1)
End If
Next
' Remove last empty item
ReDim Preserve VisibleRows(UBound(VisibleRows()) - 1)
GetVisibleRows = VisibleRows
End Function
If you would like to use this function in a lookup scenario, you need to convert the absolute row numbers returned by the function to relative row numbers of the table. Following worked for me.
RowIndex = ReturnedRowIndex - LookupRange.Rows(1).Row + 1
Good luck!
I have an Excel table in which sometimes an entire cell has the following content:
pos=51;70;112;111;132;153
Note the whole content in in a single cell, that is to say the value 51;70;112... are strings clumped together in a single cell and not in their own cells.
Can I write a macro that in all cells that contain the keyphrase "pos=", add 2 to each value, so that the end result is:
pos=53;72;114;113;134;155
Here is a code that will do it (tested on a sample on my Excel 2003):
Sub t()
Dim rCells As Range, c As Range
Dim arr As Variant, i As Integer
'Define the range to apply the code
Set rCells = Range("A1")
For Each c In rCells
'check if the cell desserves to be changed (could be adapted though to another check)
If Left(c.Value, 4) = "pos=" Then
'split all the values after the "pos=" into an array
arr = Split(Mid(c.Value, 5, Len(c.Value)), ";")
'add +2 to every value of the array (we convert the value to be sure, probably unneeded)
For i = 0 To UBound(arr)
arr(i) = CLng(arr(i)) + 2
Next i
'set back the value to the worksheet
c.Value = "pos=" & Join(arr, ";")
End If
Next c
End Sub
Note that I didn't add the error checking part if your values aren't well formated.
You know that you can easily split data without using macros, right? Just use the TextToColumns function on the Data tab
But if you really want a macro, you can do something like the following:
Sub AddNumber()
Dim numberToAdd As Integer
numberToAdd = 2
Set myRange = Range("A1:A5")
For Each myCell In myRange
If Left(myCell.Value, 4) = "pos=" Then
arEquality = Split(myCell, "=")
arElements = Split(arEquality(1), ";")
For i = 0 To UBound(arElements)
arElements(i) = arElements(i) + numberToAdd
Next
myCell.Offset(0, 1).Value = arEquality(0) + "=" + Join(arElements, ";")
End If
Next
End Sub
The following function returns a "type mismatch". I don't understand, as I paid attention to using the "Set" instruction to return my resulting range.
I debugged the function, I get a proper range to return, so the problem is elsewhere.. Hmmmm...
Function getVals(column As String) As Range
Dim col As Variant
col = Application.Match(column, ThisWorkbook.ActiveSheet.Range("1:1"), 0)
Dim rng As Range
Set rng = ThisWorkbook.ActiveSheet.Cells(1, col)
Set rng = rng.Offset(1, 0)
Set rng = Range(rng, rng.End(xlDown))
Set getVals = rng
End Function
Thanks in advance guys for any help :)
UPDATE : I am looking at how to send my results as an array. I tried combinations of the function returning "variant"/"variant()" type, and passing rng.value2 as result, but no success.
To return your results as an array of values, simply change the return type to Variant and return rng.Value. The below code works for me as long as the passed column string exists in ThisWorkbook.ActiveSheet.Range("1:1").
Function getVals(column As String) As Variant
Dim col As Variant
col = Application.Match(column, ThisWorkbook.ActiveSheet.Range("1:1"), 0)
Dim rng As Range
Set rng = ThisWorkbook.ActiveSheet.Cells(1, col)
Set rng = rng.Offset(1, 0)
Set rng = Range(rng, rng.End(xlDown))
getVals = rng.Value
End Function
Sub TestingGetVals()
Dim v As Variant, i As Integer
v = getVals("a") ' returns a 2-D array
For i = 1 To UBound(v)
Debug.Print v(i, 1)
Next i
End Sub
You are getting that error because Match is not able to find what you want and hence your rng is evaluating to "nothing" :)
Consider this code
Option Explicit
Sub Sample()
Dim Ret As Range
If Not getVals("Value To Match") Is Nothing Then
Set Ret = getVals("Value To Match")
MsgBox Ret.Address
Else
MsgBox "Value To Match - Not Found"
End If
End Sub
Function getVals(column As String) As Range
Dim col As Variant
Dim rng As Range
On Error GoTo Whoa
col = Application.Match(column, ThisWorkbook.ActiveSheet.Range("1:1"), 0)
Set rng = ThisWorkbook.ActiveSheet.Cells(1, col)
Set rng = rng.Offset(1, 0)
Set rng = Range(rng, rng.End(xlDown))
Set getVals = rng
Exit Function
Whoa:
Set getVals = Nothing
End Function
Firstly I do not understand what you are doing. You have a parameter column but you are searching for a cell within row 1 that contains that value. For example, if column = 23, and P1 contains 23, Match should return 16.
Your routine fails because if the Match fails, col is set to Error 2042. You should test col before using it as a number.
In my test I set row 1 to numbers in a random sequence. My Match failed because cell P1 contained number 23 but variable column contains string "23". When I reclassified column as Long, the Match worked.
I am unhappy with Siddharth's use of On Error. I do not like to use On Error for errors I expect. I would test col to be numeric after the Match.
Other people are faster at writing then I am. :-) There is one other possibility that hasn't been mentioned yet.
Since you didn't get the error when debugging, the issue might be your use of ActiveSheet. If the wrong worksheet is active then Match will cause the error as stated by the other answers.
If you are explicit, does the error go away?
col = Application.Match(column, ThisWorkbook.Sheet(1).Range("1:1"), 0)