I am attempting to do a VLOOKUP on a different worksheet based on given parameters in the function. I've played around with it for several hours and can not figure out why it is not working. I cut down the code as much as I could to test, but am unable to effectively find a solution. I think it might be an issue of how I am calling the range from the other worksheet for the VLOOKUP. Code is below. Please advice. If I'm unclear about what I'm asking just ask and I will provide feedback. Thank you
Function GraphDataA(cR As String, time As String, aClient As String, tps As String, dat As String)
Dim client As Boolean
Dim day As Boolean
Dim tot As Boolean
Dim dayTotData As Range
Dim dayTotDatas As Worksheet
Set dayTotDatas = ActiveWorkbook.Sheets("DayTot")
Set dayTotData = dayTotDatas.Range("A3:AI168")
client = False
day = False
tot = False
If date = "" Then
GraphDataA = ""
End If
If aClient = "" Then
GraphDataA = ""
End If
If cR = "Client" Then
client = True
End If
If time = "Day" Then
day = True
End If
If tps = "Total" Then
tot = True
End If
If client = True Then
If day = True Then
If tot = True Then
GraphDataA = WorksheetFunction.VLookup(aClient, dayTotData, WorksheetFunction.Match(dat, dayDate, 0) + 8, _
False)
End If
End If
End If
End Function
VLOOKUP() will throw an error if nothing matches. So you need to add error catching code to your function.
You need to modify the function as
Function MyFunction() as Something
On Error Goto ErrorHandler
' Your existing code goes here
Exit Function
ErrorHandler:
MyFunction = -1 ' Or something which indicates that the value isn't found
End Function
You don't appear to be returning any value from your function. Try adding As Variant to the end of the first line like so:
Function GraphDataA(cR As String, time As String, aClient As String, tps As String, dat As String) As Variant
Related
In the code I am posting, I am using a check box called "ACDS Test" and whenever it is checked it creates a sheet, then when it becomes unchecked it calls the upper function and deletes the sheet.
I am trying to add a message box that essentially works like a fail safe to ensure they want to delete the page. If they say they do not want to delete the page then I want the checkbox to stay checked.
For some reason I am getting this error message when I try to pass the value to make sure the checkbox stays checked and I cannot figure out why.
The error comes up on the line:
Sub ACDSTest_Click(CorrectValue As Integer)
And the specific error is: "Compile error: Procedure Declaration does not match description of event or procedure having the same name".
Any help is much appreciated! IF any more clarification is needed please feel free to ask!
Sub DeleteWorksheet(NameSheet As String)
Dim Ans As Long
Dim t As String
Dim CorrectValue As Integer
Dim i As Long, k As Long
k = Sheets.Count
Ans = MsgBox("Would you like to take this test off of the form?", vbYesNo)
Select Case Ans
Case vbYes
'Code reads through each page and finds one with corresponding name to string t
'Once it finds the correct page, it deletes it
For i = k To 1 Step -1
t = Sheets(i).Name
If t = NameSheet Then
Sheets(i).Delete
End If
Next i
CorrectValue = 0
Case vbNo
CorrectValue = 1
End Select
End Sub
Sub ACDSTest_Click(CorrectValue As Integer)
Dim NameSheet As String
Dim NameValue As String
NameSheet = "ACDS"
NameValue = "ACDS Test"
If ACDSTest.Value = True Then
CreateWorksheet (NameSheet), (NameValue)
Worksheets("Sheet1").Activate
Else
DeleteWorksheet (NameSheet)
If CorrectValue = 1 Then
ActiveSheet.Shapes("ACDS Test").ControlFormat.Value = 1
End If
End If
End Sub
The issue here is that the CorrectValue variable as you define it in DeleteWorksheet does not exist in the context of the
variable does not exist in context of the ACDSTest_Click subroutine. This is because variables defined within subroutines or functions are local to those functions. To correct this I would convert DeleteWorksheet to a function such as the below.
Further, the event that fires Private Sub ACDSTest_Click() cannot handle passing a value to that function, so changing it to Sub ACDSTest_Click(CorrectValue As Integer) causes an error.
Function DeleteWorksheet(ByVal SheetName As String) As Boolean
On Error GoTo SheetDNE
SheetName = Sheets(SheetName).Name 'Check if sheet exists w/o other objects
On Error GoTo 0
Select Case MsgBox("Would you like to take this test off of the form?", vbYesNo)
Case vbYes
Application.DisplayAlerts = False
Sheets(SheetName).Delete
Application.DisplayAlerts = True
DeleteWorksheet = True
Case Else: DeleteWorksheet = False
End Select
Exit Function 'Exit The Function w/o error
SheetDNE: 'Sheet Does Not Exist
MsgBox "The indicated sheet, " & SheetName & ", does not exist", vbOKOnly
End Function
And
Private Sub ACDSTest_Click()
Dim NameSheet As String
Dim NameValue As String
NameSheet = "ACDS"
NameValue = "ACDS Test"
If ACDSTest.Value = True Then
CreateWorksheet (NameSheet), (NameValue)
Worksheets("Sheet1").Activate
Else
If Not DeleteWorksheet(NameSheet) Then _
ActiveSheet.Shapes("ACDS Test").ControlFormat.Value = 1
End If
End Sub
I want to use VBA to do something about a normal MS word paragraph. But a display mode equation looks just like a paragraph. Can anybody tell me, please, the difference between them? Or provide a VBA example to distinguish them.
Function IsADisplayModeEquation(ParagraphIndex As Long)
Dim ParagrapLineNum As Long
Dim EquationLineNum As Long
ParagrapLineNum = ActiveDocument.Paragraphs(ParagraphIndex).Range.Information(wdFirstCharacterLineNumber)
n = ActiveDocument.Bookmarks("\page").Range.OMaths.Count
For I = 1 To n
EquationLineNum = ActiveDocument.Bookmarks("\page").Range.OMaths(I).Range.Information(wdFirstCharacterLineNumber)
If (ParagrapLineNum = EquationLineNum) And ActiveDocument.Bookmarks("\page").Range.OMaths(I).Type = wdOMathDisplay Then
IsADisplayModeEquation = True
Exit Function
End If
Next I
IsADisplayModeEquation = False
End Function
A ugly function：
Function IsADisplayModeEquation(ParagraphIndex As Long)
Dim ParagrapLineNum As Long
Dim EquationLineNum As Long
ParagrapLineNum = ActiveDocument.Paragraphs(ParagraphIndex).Range.Information(wdFirstCharacterLineNumber)
n = ActiveDocument.Bookmarks("\page").Range.OMaths.Count
For I = 1 To n
EquationLineNum = ActiveDocument.Bookmarks("\page").Range.OMaths(I).Range.Information(wdFirstCharacterLineNumber)
If (ParagrapLineNum = EquationLineNum) And ActiveDocument.Bookmarks("\page").Range.OMaths(I).Type = wdOMathDisplay Then
IsADisplayModeEquation = True
Exit Function
End If
Next I
IsADisplayModeEquation = False
End Function
I have a standard user defined function that concationates all the unique values. What I am trying to do is to perform this function on a range that satisfies a condition.
Function ConcatUniq(xRg As Range, xChar As String) As String
'updateby Extendoffice 20151228
Dim xCell As Range
Dim xDic As Object
Set xDic = CreateObject("Scripting.Dictionary")
For Each xCell In xRg
xDic(xCell.Value) = Empty
Next
ConcatUniq = Join$(xDic.Keys, xChar)
Set xDic = Nothing
End Function
Lets make an example:
If we have the following data:
A1:A5 = {1,2,2,4,1}
B1:B5 = {"group1", "group1","group1", "group2", "group2"}
C1 = "group1"
Now I want to find the unique values using the ConcatUniq function for all numbers that are in group1. Usually, if I want to perform another function for example the median I would do the following:
=MEDIAN(IF(B1:B5=C1,A1:A5))
Activate it using cntrl shift enter which gives 2 (create an array function from it).
For some reasons this does not work in combination with a user defined function.
=ConcatUniq(IF(B1:B5=C1,A1:A5)," ")
Desired result:
1 2
Does someone know how I could fix this problem?
You need to use ParamArray to accommodate array returned from Excel's array formula. As ParamArray should always be the last one, so your method signature will change.
This will work with =ConcatUniq(" ",IF(B1:B5=C1,A1:A5)) on CTRL + SHIFT + ENTER
Public Function ConcatUniq(xChar As String, ParamArray args())
Dim xDic As Object
Dim xVal
Set xDic = CreateObject("Scripting.Dictionary")
For Each xVal In args(0)
If Not Not xVal Then
xDic(xVal) = Empty
End If
Next
ConcatUniq = Join$(xDic.Keys, xChar)
End Function
Perhaps something like this:
Public Function ConcatUniq(ByVal rangeOrArray As Variant, ByVal xChar As String) As String
Dim generalArray As Variant
If IsArray(rangeOrArray) Then
'operate on it as if was an array
generalArray = rangeOrArray
Else
If TypeName(rangeOrArray) = "Range" Then
'operate on it as if was a Range
If rangeOrArray.Cells.Count > 1 Then
generalArray = rangeOrArray.Value
Else
generalArray = Array(rangeOrArray.Value)
End If
Else
'Try to process as if it was a derivative of a value of a single cell range.....
generalArray = Array(rangeOrArray)
End If
End If
Dim xDic As Object
Set xDic = CreateObject("Scripting.Dictionary")
Dim xCell As Variant
For Each xCell In generalArray
If xCell <> False Then xDic(xCell) = Empty ' EDIT - HACKY....
Next
ConcatUniq = Join$(xDic.Keys, xChar)
End Function
You can see that that whole block of if-elses can be factored out to be a separate function to transform worksheet input to a unified form for operating on values of a worksheet.
The easiest solution would probably be to introduce an additional function. This function would take care of the condition and would generate an array consisting only of data fulfilling the condition.
Try something like this:
function condition_check(data1() as integer, data2() as string, condition_value as string) as integer
number_of_elements = Ubound(data1)
j = 0
for i = 0 to number_of_elements
if data2(i) = condition_value then
condition_check(j) = data1(i)
j = j+1
end if
next i
end function
I have a simple Function to get and save values in array:
Function GetDataOwner()
Dim DataOwner(2) As String
DataOwner(0) = Sheets(1).Range("H21").Value
DataOwner(1) = Sheets(1).Range("I21").Value
DataOwner(2) = Sheets(1).Range("J21").Value
End Function
In other function, I would like read value:
Sub GenerateDB()
Dim DataOwner() As String
DataOwner = GetDataOwner()
MsgBox DataOwner(1)
End Sub
But Excel say me error 13 type mismatch. I am novice with VBA function
Soluce:
Function GetDataOwner()
Dim DataOwner(2) As String
DataOwner(0) = Sheets(1).Range("H21").Value
DataOwner(1) = Sheets(1).Range("I21").Value
DataOwner(2) = Sheets(1).Range("J21").Value
GetDataOwner = DataOwner
End Function
Sub GenerateDB()
Dim DataOwner() As String
DataOwner = GetDataOwner()
MsgBox DataOwner(1)
End Sub
Thanks to #Comintern
I am trying to write a simple code that filters out data based on some condition.
My code is below :
Public Function fGetUniqInitiative(Optional ByVal uniqInitiative As Variant, Optional ByVal filter1 As Variant, Optional ByVal filter2 As Variant, Optional ByVal filter3 As Variant, Optional ByVal vartempData As Variant) As Variant()
Dim lngcounterinitiatve As Long
Dim lngVarData As Long
Dim lngfilter1 As Long
Dim lngfilter2 As Long
Dim lngfilter3 As Long
Dim boolfilter1 As Boolean
Dim boolfilter2 As Boolean
Dim boolfilter3 As Boolean
Dim varUniqueList() As Variant
Dim lnguniqueinitcount As Long
lnguniqueinitcount = 0
For lngcounterinitiative = LBound(uniqInitiative) To UBound(uniqInitiative)
boolfilter1 = False
boolfilter2 = False
boolfilter3 = False
For lngVarData = LBound(vartempData) To UBound(vartempData)
If uniqInitiative(lngcounterinitiative) = vartempData(lngVarData, 2) Then
For lngfilter1 = LBound(filter1) To UBound(filter1)
If vartempData(lngVarData, 9) = filter1(lngfilter1) Then
boolfilter1 = True
Exit For
End If
Next lngfilter1
For lngfilter2 = LBound(filter2) To UBound(filter2)
If vartempData(lngVarData, 10) = filter2(lngfilter2) Then
boolfilter2 = True
Exit For
End If
Next lngfilter2
For lngfilter3 = LBound(filter3) To UBound(filter3)
If vartempData(lngVarData, 11) = filter3(lngfilter3) Then
boolfilter3 = True
Exit For
End If
Next lngfilter3
If boolfilter1 = True Or boolfilter2 = True Or boolfilter3 = True Then
Exit For
Else
lnguniqueinitcount = lnguniqueinitcount + 1
ReDim varUniqueList(1 To lnguniqueinitcount)
End If
End If
Next lngVarData
Next lngcounterinitiatve
fGetUniqInitiative = varUniqueList
End Function
However, when i try to compile the code it gives the error "Invalid Next Control Variable reference". I have googled it quite a bit and all the solutions say that i must be missing closing the loop which i don't think is the case in my code. Anyone could point what am i missing?
lngcounterinitiative is spelled wrong in "Next lngcounterinitiatve".Try changing that.