I've got the following:
Private Sub cmdColumnLetter_Click()
Dim colRange As Range
Set colRange = Excel.Application.InputBox( _
Prompt:="Please Select Any Cell In ""Splitter"" Column", _
Title:="Column", _
Default:=fTableRange.Columns(1).Column, Type:=8)
fColNumber = colRange.Column
TxBoxColumnNum = fColNumber
End Sub
If the user hits cancel then Set colRange = fails as it is looking to assign an object to this variable. Do I have to use an On Error structure to defend against this error or is there a more elegant approach?
Different syntax for assigning objects and values is, IMO, one drawback of VBA.
As such, functions as InputBox returning objects or values cause errors.
However, function arguments passing syntax is same.
Exploring this, I purpose and alternative solution, indeed not better then error handling solution:
Function SetObject(v, ByVal ExpectedTypeName As String) As Object
If TypeName(v) = ExpectedTypeName Then Set SetObject = v
End Function
Private Sub cmdColumnLetter_Click()
Dim colRange As Range
Set colRange = SetObject(Excel.Application.InputBox("input", Type:=8), "Range")
If Not colRange Is Nothing Then
Debug.Print "..."
End If
End Sub
SetObject accepts either an object or a value, but always retuns given object if typename matchs expected one or Nothing if doesn't match.
Yes, you will have to OERN
Sub Test()
Dim colRange As Range
Dim fColNumber As Long, TxBoxColumnNum As Long
On Error Resume Next
Set colRange = Excel.Application.InputBox( _
Prompt:="Please Select Any Cell In ""Splitter"" Column", _
Title:="Column", Default:=fTableRange.Columns(1).Column, Type:=8)
On Error GoTo 0
If colRange Is Nothing Then Exit Sub
fColNumber = colRange.Column
TxBoxColumnNum = fColNumber
End Sub
Related
I want to hide several columns (that's not close to each other) in 1 line (shown below) in VBA but it doesn't work. What's wrong with it?
Columns("A, C:D").hidden = True
Use Range.EntireColumn.
Range("A:A,C:D").EntireColumn.Hidden = True
This thread is similar, and this answer demonstrates that Union is another option here as well.
Note that .EntireColumn is necessary; omitting it will throw a
Run-time error '1004':
Unable to set the Hidden property of the Range class.
Hide Columns Using Union
The best answer is already posted so here is kind of a cheating one: it is one line, but uses a function (with 'several' lines).
Option Explicit
Sub hideColumns()
CombinedColumns(ActiveSheet, "A,C,H,K:M,O,R:U").Hidden = True
End Sub
Function CombinedColumns( _
ByVal ws As Worksheet, _
ByVal ColumnsList As String, _
Optional ByVal Delimiter As String = ",") _
As Range
Dim Cols() As String: Cols = Split(ColumnsList, Delimiter)
Dim rg As Range
Dim n As Long
For n = 0 To UBound(Cols)
If rg Is Nothing Then
Set rg = ws.Columns(Cols(n))
Else
Set rg = Union(rg, ws.Columns(Cols(n)))
End If
Next n
If Not rg Is Nothing Then
Set CombinedColumns = rg.EntireColumn
End If
End Function
I have googled and struggled with this for hours now.
I have a Control workbook, that pulls data from a varied amount of other workbooks (the Control workbook also creates the other workbooks and saves the names and dir of said workbooks so that they can be called later)
This piece of code is the problem.
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Declare_Sheets
Dim SearchresultROW
Dim Searchresult As String
Dim complexrow As Integer
Dim CurrSheet As Worksheet
Dim Stype As String
Dim startROW As Integer
Dim endROW As Integer, SearchCOL As Integer, OffROW As Integer
Dim PDATArange As Range, CDATArange As Range
Dim Dateyear, Datemonth, datetest As String
Stype = WSRD.Range("B11")
'Find complex to work with
complexrow = WSSS.Range("F7")
WSSS.Activate
SearchresultROW = Range(Cells(7, 15), Cells(complexrow, 15).Find(Callsheet).Address).Row
Searchresult = WSSS.Cells(SearchresultROW, 15).Offset(0, 1)
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
The below code is the problem extract
complexrow = WSSS.Range("F7")
WSSS.Activate
SearchresultROW = Range(Cells(7, 15), Cells(complexrow, 15).Find(Callsheet).Address).Row
Searchresult = WSSS.Cells(SearchresultROW, 15).Offset(0, 1)
1st problem
I cant get the find() to work without activating worksheet - WSSS
Declare_Sheets gets run at the start which declares WSSS, this works everywhere else in my code, but not with this find().
2nd problem
The code below compiles and finishes, BUT - It does not return the correct data.
This code calls starts the macro
Cancel = True
Dim Calsheet As String
If Target.Column <> 1 Then Exit Sub
Calsheet = Target.Value
Call Call_Readings(Calsheet)
End Sub
There are currently 2 possibilities
I double click on Casper Tcomp 4.
Callsheet = "Casper Tcomp 4" - Which is correct (target of the double click)
Complexrow = "9" - Which is correct (this will increment as new sheets are added)
SearchresultROW = "7" - This is wrong, it should be 8
I have tried adding LookAt:=xlWhole and LookIn:-xlValues, doesnt change a thing
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Declare_Sheets
Dim SearchresultROW
Dim Searchresult As String
Dim complexrow As Integer
Dim CurrSheet As Worksheet
Dim Stype As String
Dim FindResult As Range
Dim startROW As Integer
Dim endROW As Integer, SearchCOL As Integer, OffROW As Integer
Dim PDATArange As Range, CDATArange As Range
Dim Dateyear, Datemonth, datetest As String
Stype = WSRD.Range("B11")
'Find complex to work with
complexrow = WSSS.Range("F7")
On Error Resume Next 'next line will error if nothing is found
Set FindResult = WSSS.Range(WSSS.Cells(7, 15), WSSS.Cells(complexrow, 15)).Find(What:=Callsheet, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchByte:=False)
On Error GoTo 0 'always re-activate error reporting!
If Not FindResult Is Nothing Then 'check if find was successful
SearchresultROW = FindResult.Row
Searchresult = WSSS.Cells(SearchresultROW, 15).Offset(0, 1)
Else 'if nothing was found show message
MsgBox "NO WB FOUND.", vbCritical
End If
This solved the problem, thanks for the assistance Pᴇʜ
Your code without .Activate would look something like below. Note that every Range, Cells, Rows or Columns object needs to be referenced with the correct Workbook/Worksheet:
complexrow = WSSS.Range("F7")
'try to find something
Dim FindResult As Range
On Error Resume Next 'next line will error if nothing is found
Set FindResult = WSSS.Cells(complexrow, 15).Find(What:=Callsheet, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchByte:=False)
On Error GoTo 0 'always re-activate error reporting!
If Not FindResult Is Nothing Then 'check if find was successful
SearchresultROW = WSSS.Range(WSSS.Cells(7, 15), FindResult).Row
Searchresult = WSSS.Cells(SearchresultROW, 15).Offset(0, 1)
Else 'if nothing was found show message
MsgBox "nothing found.", vbCritical
End If
Note that if using the Range.Find method you need to check if something was found before you can use the result of Find. Otherwise it will throw an error. Also note that the documentation of Find says that …
The settings for LookIn, LookAt, SearchOrder, and MatchByte are saved each time you use this method.
So if you don't define them each time using Find it will use whatever was used last by either VBA or the user interface. Since you have no control about what was used last by the user interface I highly recomment to define them everytime using Find or you will get random results.
Also note that Callsheet is not defined in your code yet, so check that.
Trying to write a VBA function that will return the column number given the header cell string and the worksheet name but I get the Subscript out of range error.
Here is the function:
Public Function namedColumnNo(heading As String, shtName As String) As Long
' Return the column number with named header text'
' on given worksheet.
Dim r As Range
Dim wks As Worksheet
Debug.Print shtName
'Exit Function
Set wks = Sheets(shtName)
wks.Range("1:1").Select
With wks
r = .Range("1:1").Find(heading, LookIn:=xlValue)
If r Is Nothing Then
namedColumnNo = -1
Else: namedColumnNo = r.Column
End If
End With
End Function
I am using this test sub to call the funtion:
Public Sub getCol()
Debug.Print "Find MidTemp on " & DataSht.RawDataSht
Debug.Print "Col " & namedColumnNo("MidTemp", DataSht.RawDataSht)
End Sub
I have a user defined type DataSht where I have variables to name worksheets e.g.
Public Type dataShtNames
HeaderSht As String
RawDataSht As String
ResultDataSht As String
End Type
Public DataSht As dataShtNames
With the Exit Function statement uncommented the variables resolve OK with the debug.print statements I get
Find MidTemp on RawData
RawData:MidTemp
Col 0
Leaving the function to run through the error occurs at
Set wks = Sheets(shtName)
If I replace the argument shtName with the actual sheet name as a string "RawData", then the error moves down to the line using the second argument heading. If I substitute a the parameter with a string here the error persists.
Is there something I am missing here? Some help will be much appreciated.
Sadly can't comment, but you're actually getting the out of range error because it should be LookIn:=xlValues where you have LookIn:=xlValue
As #Mathieu indicates, you'll need to fix add Set r = Find(heading, LookIn:=xlValues) to set the range to the value returned.
As a side note-you should drop the selection. Its not doing anything for you.
With wks.Range("1:1")
Set r = .Find(heading, LookIn:=xlValues)
If r Is Nothing Then
namedColumnNo = -1
Else: namedColumnNo = r.Column
End If
End With
I'm trying to determine if a named range has been set via VBA. The named range is called LoadedToken and essentially is loaded when a user clicks a particular button. I use this as proof that initialisation has taken place.
I have a function to check if this has taken place:
Function ToolIsEnabled()
' We check if the R2A add-in has been loaded by detecting the named range
If ActiveWorkbook.Names("LoadedToken") Is Nothing Then
ToolIsEnabled = False
Else
ToolIsEnabled = True
End If
End Function
and I get an application error. Of course, the VBA is incorrect. However how can I actually accomplish this?!
Sub Test()
Debug.Print IsNamedRange("Bumsti")
End Sub
Function IsNamedRange(RName As String) As Boolean
Dim N As Name
IsNamedRange = False
For Each N In ActiveWorkbook.Names
If N.Name = RName Then
IsNamedRange = True
Exit For
End If
Next
End Function
Usage in OP context could be
' ...
If IsNamedRange("LoadedToken") Then
' ...
End If
' ...
or - if a program specific Bool needs to be set
' ...
Dim IsTokenLoaded as Boolean
IsTokenLoaded = IsNamedRange("LoadedToken")
' ...
Both constructs make it pretty clear in the source code what you are aiming for.
You can achieve this by using error handling:
Function ToolIsEnabled() As Boolean
Dim rng As Range
On Error Resume Next
Set rng = ActiveWorkbook.Range("LoadedToken")
On Error GoTo 0
ToolIsEnabled = Not rng is Nothing
End Function
This will check either in ThisWorkbook or a named workbook and return TRUE/FALSE.
Sub Test()
MsgBox NamedRangeExists("SomeName")
MsgBox NamedRangeExists("SomeOtherName", Workbooks("Book1.xls"))
End Sub
Public Function NamedRangeExists(sName As String, Optional Book As Workbook) As Boolean
On Error Resume Next
If Book Is Nothing Then
Set Book = ThisWorkbook
End If
NamedRangeExists = Book.Names(sName).Index <> (Err.Number = 0)
On Error GoTo 0
End Function
Edit:
A shorter version if it's only going to look in ThisWorkbook:
Public Function NamedRangeExists(sName As String) As Boolean
On Error Resume Next
NamedRangeExists = ThisWorkbook.Names(sName).Index <> (Err.Number = 0)
On Error GoTo 0
End Function
For the activeworkbook, you could also call the old XLM NAMES() function:
Function IsNameInActiveWorkbook(sName As String) As Boolean
IsNameInActiveWorkbook = Not IsError(Application.ExecuteExcel4Macro("MATCH(""" & sName & """,NAMES(),0)"))
End Function
As per Tom's answer these 2 line should do the trick:
On Error Resume Next
Set TestRange = ActiveWorkbook.Range("LoadedToken") 'if it does **not** exist this line will be ERROR
I have recorded an Excel function (Iferror/Vlookup) which I need to modify to inpput variables to make it more dynamic (Allow for columns moving). Below is a brief outline of what I want to do. The First section is the recorded Function and the variables I want to add. The second section is my proposed solution. My problem is I need to drop the function into excel and copy it down over 50,000 rows. So my error handling solution won't work here. Is it possilbe to make the original recorded function dynamic using iferror/Vlookup. Any help appreciated.
Dim Lookup1 As Long
Dim LookupOffset As Long
Dim LRange As Range
Lookup1 = -99
LookupOffset = 28
Set LRange = Column("CU:CV")
With Worksheets("consolidated")
.Cells(2, 99).FormulaR1C1 = _
"=RC[-71]-IFERROR(VLOOKUP(RC[-12],C[-2]:C[-1],2,FALSE),0)"
.Cells(2, 99).Copy Range(.Cells(2, 99), .Cells(glLastRow, 99))
Application.CutCopyMode = False
.Calculate
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Proposed Solution
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Res As Variant
On Error Resume Next
Err.Clear
Res = Application.WorksheetFunction.VLookup(Lookup1 - LookupOffset, LRange, 2, False)
If Err.Number = 0 Then
''''''''''''''''''''''''''''''''''''''''''''''''''''
' Value found by VLookup. Continue normal execution.
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Else
''''''''''''''''''''''''''''''''''''''''''''''''''''
' Value NOT found by VLookup. Error handling code here.
'''''''''''''''''''''''''''''''''''''''''''''''''''''
End If
Try this one:
Sub LookUpMod()
Dim wSht As Worksheet: Set wSht = ThisWorkbook.Sheets("Consolidated")
With wSht
On Error Resume Next
.Cells(2, 99).Formula = "=XCV34-IFERROR(VLOOKUP(XFC34,$I:$J,2,FALSE),0)"
.Range(Cells(2, 99), Cells(glLastRow, 99)).FillDown
.Calculate
On Error GoTo 0
End With
End Sub
Just noticed, though, that you don't have glLastRow instantiated properly. Let us know if this helps.
EDIT:
As per chat with OP:
Function LookUpMod(Str As Variant, Rng As Range, OffsetToRight As Long)
Application.Volatile
LookUpMod = Rng.Cells.Find(What:=Str).Offset(0, OffsetToRight).Value
End Function
A simple flexible lookup is what is needed.