I'm trying to figure this out and can't.
I keep getting an error: "Compile error - Argument not optional". I am supplying the arguments and they are set as Optional!
Trying to pass a string and an array to a function and count occurrences of the array strings within the string passed.
Code stops running at the line:
Public Function countTextInText(Optional text As String, Optional toCountARR As Variant) As Integer
with a "Compile error: Argument not optional" message highlighting the Val in the line:
For Each Val In toCountARR
Full code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim nameR As Range
Dim colR As Range
Dim TKRcnt As Integer
Dim TKRarr() As Variant
TKRarr = Array("TKR", "THR", "Bipolar")
Dim ORIFcnt As Integer
Dim ORIFarr() As Variant
TKRarr = Array("ORIF", "Ilizarov", "PFN")
Set nameR = Range("P2:P9")
Set colR = Range("B2:B50,G2:G50,L2:L50")
For Each namecell In nameR
For Each entrycell In colR
If entrycell.text = namecell.text Then
TKRcnt = countTextInText(entrycell.Offset(0, 2).text, TKRarr)
ORIFcnt = countTextInText(entrycell.Offset(0, 2).text, TKRarr)
End If
Next entrycell
MsgBox (namecell.text & " TKR count: " & TKRcnt & " ORIF count: " & ORIFcnt)
Next namecell
End Sub
Public Function countTextInText(Optional text As String, Optional toCountARR As Variant) As Integer
Dim cnt As Integer
Dim inStrLoc As Integer
For Each Val In toCountARR
inStrLoc = InStr(1, text, Val)
While inStrLoc <> 0
inStrLoc = InStr(inStrLoc, text, Val)
cnt = cnt + 1
Wend
Next Val
Set countTextInText = cnt
End Function
Val is a VBA function which requires a single, mandatory, argument - therefore the compiler generates the message saying "Argument not optional" if you don't provide that argument. (MSDN documentation of Val)
It is a bad idea to use VBA function names as variable names, so I would recommend you don't use Val as a variable name - use myVal or anything else that VBA hasn't already used.
If you really want to use Val (and you are sure that you won't be needing to access the Val function at all), you can use it as a variable name if you simply declare it as such, e.g.
Dim Val As Variant
You will also have problems with your line saying
Set countTextInText = cnt
as countTextInText has been declared to be an Integer, and Set should only be used when setting a variable to be a reference to an object. So that line should be
countTextInText = cnt
For those coming late to this question because of the question's title, as I did, having received this error while using the .Find method -
In my case, the problem was that the variable I was Seting was not Dimd at top of function.
My Example
Sub MyTest()
Dim tst, rngAll
rngAll = [a1].CurrentRegion
tst = fnFix1Plus1InValues(ByVal rngAll As Range)
End Sub
Public Function fnFix1Plus1InValues(ByVal rngAll As Range) As Boolean
Dim t1, t2, arr, Loc '<=== Needed Loc added here
Set Loc = rngAll.Find(What:="+", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
If Not Loc Is Nothing Then
Do Until Loc Is Nothing
t1 = Loc.Value
If fnContains(t1, "+") Then
'Do my stuff
End If
Set Loc = rngAll.FindNext(Loc)
Loop
End If
End Function 'fnFix1Plus1InValues
Related
I have faced a strange issue(Maybe a bug) at Data Validation
When i use below code for data validation, Excel is creating a dropdown but add string as one line. But when i write the same string from Excel data validation menu, Excel is seperating the dropdown with multiple items which i want.
For example, lets say string is "A;B;C"
When i do it by VBA, dropdown shows "A;B;C" as 1 line but when i click data validation menu and write manually "A;B;C" , Excel is creating 3 lines of dropdown with "A" , "B" , "C"
It is totally strange behavior. You may see the code as below. I add video link to explain better.
https://streamable.com/a75kud
Public arrAddress As String
Sub DynamicDataVal()
Dim rng As Range
Dim cll As Range
Dim dValicationCount As Long
Dim un As String
Dim DValidationList As Range
Dim DValidationListString As String
Dim seper As String
Dim col As New Collection, a
Dim colIt As Variant
Dim arr() As Variant
un = "Sayin " & Environ("UserName")
On Error Resume Next
Set rng = Application.InputBox("Lutfen Veri Alanini Seciniz", un, ActiveCell.Address, , , , , 8)
If rng Is Nothing Then Exit Sub
Set cll = ActiveCell
dValicationCount = cll.SpecialCells(xlCellTypeSameValidation).Count
If dValicationCount = 0 Then
arr = rng.Offset(1, 0).Resize(rng.Resize(, 1).Cells.Count - 1, 1).Value
arrAddress = rng.Address(External:=True)
For Each a In arr
col.Add a, a
Next a
seper = ListSeperatorMod.GetListSeparator
For Each colIt In col
DValidationListString = DValidationListString & seper & colIt
Next colIt
DValidationListString = Right(DValidationListString, Len(DValidationListString) - 1)
On Error GoTo 0
With cll.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:=DValidationListString
End With
Else
If rng.Validation.Type <> 3 Then
Exit Sub
Else
'Will be done
End If
End If
On Error GoTo 0
End Sub
Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" _
(ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Private Declare Function GetUserDefaultLCID% Lib "kernel32" ()
Private Const LOCALE_SLIST = &HC
Public Function GetListSeparator() As String
Dim ListSeparator As String
Dim iRetVal1 As Long
Dim iRetVal2 As Long
Dim lpLCDataVar As String
Dim Position As Integer
Dim Locale As Long
Locale = GetUserDefaultLCID()
iRetVal1 = GetLocaleInfo(Locale, LOCALE_SLIST, lpLCDataVar, 0)
ListSeparator = String$(iRetVal1, 0)
iRetVal2 = GetLocaleInfo(Locale, LOCALE_SLIST, ListSeparator, iRetVal1)
Position = InStr(ListSeparator, Chr$(0))
If Position > 0 Then
ListSeparator = Left$(ListSeparator, Position - 1)
End If
GetListSeparator = ListSeparator
End Function
It's by design and it's the the same behavior you'd see if using VBA to enter a formula in a cell: you always use the "US" list separator , in VBA, and not (eg) the locale-specific separator such as ;.
This differs from entering a formula via the user interface, where you're always using the locale-specific separator.
So in VBA you might use:
Range("A1").Formula = "=MAX(A1, B2)"
and if your locale separator is ; then the formula shows up on the sheet as:
=MAX(A1; B2)
This alows the same VBA to function across different locales without modifications
I am very new to VBA, having started programming it yesterday. I am writing a data processing program which requires keeping track of two cells, one on each spreadsheet. The code which reproduces the errors I am experiencing is below. When I call the sub moveCell() in sub Processor(), nothing happens to DIRow and DIColumn, and the code spits out error 1004 at the line indicated. I have tried using DICell = DICell.Offset(), but it returns the same error.
How can I redefine a Range variable to be a different cell?
'<<Main Processor Code>>'
Sub Processor()
Dim PDRow As Integer
Dim PDColumn As Integer
Dim DIRow As Integer
Dim DIColumn As Integer
PDRow = 1
PDColumn = 1
DIRow = 1
DIColumn = 1
Dim PDCell As Range
Dim DICell As Range
Set PDCell = Worksheets("Processed Data").Cells(PDRow, PDColumn)
Set DICell = Worksheets("Data Input").Cells(DIRow, DIColumn)
Call moveCell(2, 0, "Data Input")
End Sub
'<<Function which moves the cell which defines the range>>'
Sub moveCell(r As Integer, c As Integer, sheet As String)
If sheet = "Processed Data" Then
PDRow = PDRow + r
PDColumn = PDColumn + c
Set PDCell = Worksheets("Data Input").Cells(PDRow, PDColumn)
ElseIf sheet = "Data Input" Then
DIRow = DIRow + r '<<<<<<This line does nothing to DIRow's value
DIColumn = DIColumn + c
Set DICell = Worksheets("Data Input").Cells(DIRow, DIColumn) '<<<<<<This line causes error 1004
End If
End Sub
As far as I can tell, you could instead use a quick Function instead. There doesn't seem to be any difference in your If statement results in the moveCell() function, except which worksheet you're using.
We can make this simpler by referring to the Range you're passing to moveCell.
Option Explicit ' forces you to declare all variables
Sub something()
Dim PDCell As Range
Set PDCell = Worksheets("Processed Data").Cells(1, 1)
Dim DICell As Range
Set DICell = Worksheets("Data Input").Cells(1, 1)
PDCell.Select ' can remove
Set PDCell = moveCell(2, 0, PDCell, PDCell.Worksheet.Name)
PDCell.Select ' can remove
Worksheets(DICell.Worksheet.Name).Activate ' can remove
DICell.Select ' can remove
Set DICell = moveCell(5, 0, DICell, DICell.Worksheet.Name)
DICell.Select ' can remove
End Sub
Function moveCell(rowsToMove As Long, colsToMove As Long, cel As Range, ws As String) As Range
Set moveCell = Worksheets(ws).Cells(cel.Row + rowsToMove, cel.Column + colsToMove)
End Function
I've included some rows you don't need (which I've marked with a comment afterwards), but that will show you how the routine works. You can step through with F8 to help see it step-by-step.
Edit: Although, you don't need a separate function at all. Just use OFFSET().
Set PDCell = ...whatever originally
Set PDCell = PDCell.Offset([rows],[cols])
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 writing some code for a client which pulls data from many differently laid out files. I wanted to write something which was quite flexible for him in the future.
Therefore, he will be able to write for example y.offset(0,1) in a cell depending where in regards to the variable y the data will be.
The reason I haven't just made the the variable 1 is because it, and therefore the cell, may or may not include multiple & "blah blah"
Basically, I'm wondering if it's possible to write parts of code in a cell then pull them up and incorporate them into code.
For instance:
Dim y as range
Dim x as range
Dim c as string
Set Y = Sheet1.range("G4")
c = sheet1.range("A1") [which contains the words y.offset(0,4)
Set x = c
This doesn't work, however I'm wondering if there's anything that can be done to get the same result.
Your need is kind of a recursive and dangerous one
then it deserves such a recursive and dangerous answer
you could use the VBA Project Object Model (see here for info) and act as follows:
Set your project to handle VBA Object Model
follow all the steps you can see in the Introduction of the above given link to cpearson website Add reference to your project
Disclaimer: please also read the CAUTION note in there
add "helper" module
add to your project a new Module and call it after "HelperModule" (you can call it as you like, but then be consistent with the chosen name)
then add this code into this new module
Function GetRange(refRng As Range) As Range
Set GetRange = refRng
End Function
Function SetToCellContent(refRng As Range, cellContent As String) As Range
UpdateCodeModule cellContent
Set SetToCellContent = HelpModule.GetRange(refRng)
End Function
Sub UpdateCodeModule(cellContent As String)
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Set CodeMod = ActiveWorkbook.VBProject.VBComponents("HelperModule").CodeModule
LineNum = SearchCodeModuleLine(CodeMod, "Set GetRange")
CodeMod.ReplaceLine LineNum, " Set GetRange = " & cellContent
End Sub
Function SearchCodeModuleLine(CodeMod As VBIDE.CodeModule, FindWhat As String) As Long
Dim SL As Long ' start line
Dim SC As Long ' start column
Dim EL As Long ' end line
Dim EC As Long ' end column
Dim Found As Boolean
With CodeMod
SL = 1
EL = .CountOfLines
SC = 1
EC = 255
Found = .Find(Target:=FindWhat, StartLine:=SL, StartColumn:=SC, EndLine:=EL, EndColumn:=EC, wholeword:=True, MatchCase:=False, patternsearch:=False)
End With
SearchCodeModuleLine = SL
End Function
Add this code to your main code
Set x = SetToCellContent(y, c) '<--| call the function that will take care of updating code in 'GetRange()' function and returns a range relative to 'y' as per the "code" in 'c'
I'm trying to use a helper function to get a range to store it into a variant, but I'm running into some issues.
At first, I just simply tried the following:
Function GetRange(RangeLetter As String, Optional LastUniqueLine As Long = 1048576) As Varient
Static LastUniqueLineStr As String
If LastUniqueLineStr = "" Then
LastUniqueLineStr = LastUniqueLine
End If
Set GetRange = Range(RangeLetter + "2:" + LastUniqueLineStr)
End Function
But that didn't seem to work. Range() seemed to be out of scope here or something, so I figured I had to pass in the worksheet to get it working:
Function GetRange(RangeLetter As String, Optional LastUniqueLine As Long = 1048576, Optional ActiveSheet As Worksheet) As Variant
Static LastUniqueLineStr As String
Static CurrentSheet As Worksheet
'If CurrentSheet = Nothing Then
Set CurrentSheet = ActiveSheet
'End If
If LastUniqueLineStr = "" Then
LastUniqueLineStr = LastUniqueLine
End If
Set GetRange = CurrentSheet.Range(RangeLetter + "2:" + LastUniqueLineStr) ' This is the line where I get the error.
End Function
And that's not working either. I get the following error:
Run-time error '1004':
Method 'Range' of object 'Worksheet' failed
How do I get the range I want out of this when I call it?
Try:
GetRange = Range(RangeLetter + "2:" + RangeLetter + LastUniqueLineStr).Value
You were missing a RangeLetter which was resulting in a malformed address. Also, use the .Value property to return a variant/array, and omit the Set keyword.
I continue to get the error when qualifying as CurrentSheet.Range... there is no ActiveSheet within the context of the Function, so you could pass a worksheet as a variable:
Sub Test()
Dim var As Variant
var = GetRange(ActiveSheet, "A")
End Sub
Function GetRange(sh As Worksheet, RangeLetter As String, Optional LastUniqueLine As Long = 1048576, Optional ActiveSheet As Worksheet) As Variant
Static LastUniqueLineStr As String
Dim myRange As Range
If LastUniqueLineStr = "" Then
LastUniqueLineStr = LastUniqueLine
End If
Set myRange = sh.Range(RangeLetter + "2:" + RangeLetter + LastUniqueLineStr)
GetRange = myRange.Value ' This is the line where I get the error.
End Function
It looks to me like the error is in the line where your setting Your "GetRange" variable. It looks like the result of .Range(RangeLetter + "2:" + Last....) would create a range with an address of "a2:#" which will fail. A range in that format needs to be "a2:e7" or similar. Your range reference has to be symmetrical. "RC:RC", "R:R", or "C:C". Hope that helps.