My aim is to add the values of certain columns using a user defined function in the actual row. The columns are given in another table. I am reading the name of rows, calculating the actual value and sum them. This function called once from excel but executed 4 times. At the end it indicates a circular reference error. There is no such error in the excel file, I checked if the udf return just 42 then there is no error. First I suspected Application.Caller, but ruled out.
Function SumColumnsWithSuffix(suffix As String, rowNumber) As Integer
'can be used only in Összesíto table
Dim myTable As Excel.ListObject
Dim mySheet As Excel.Worksheet
Dim myRow As Excel.ListRow
Set mySheet = ThisWorkbook.Worksheets("összesíto")
Set myTable = mySheet.ListObjects("Számlák")
Dim columnName As String
result = 0
For Each myRow In myTable.ListRows
columnName = Intersect(myRow.Range, myTable.ListColumns("Oszlop név").Range)
columnName = "Összesíto[" & columnName & " " & suffix & "]"
'actualRow = Application.Caller.row
'rowName = actualRow & ":" & actualRow
rowName = rowNumber & ":" & rowNumber
myRowRange = Range(rowName)
actualValue = Intersect(Range(columnName), Range(rowName))
result = result + actualValue
Next myRow
SumColumnsWithSuffix = result
End Function
myRowRange is not explicitly declared (or used, actually) so it is implicitly a Variant. That means your assignment here...
myRowRange = Range(rowName)
...is also making an implicit call to .Value. That call will evaluate the results of every single cell in Range(rowName) to populate the array of Variant that it returns. If any of those cells contains a call to SumColumnsWithSuffix, you'll get a circular reference.
Related
Have a piece of code that looks for matches between 2 sheets (sheet1 is customer list and rData is copied pdf with invoices). It usually is exact match but in some cases I'm looking for 6 first characters that matches rData
Dim rData As Variant
Dim r As Variant
Dim r20 As Variant
Dim result As Variant
Dim i As Long
rData = ActiveWorkbook.Sheets(2).Range("A1:A60000")
r20 = ActiveWorkbook.Sheets(1).Range("C2:C33")
For Each r In r20
result = Application.Match(r, rData, 0)
If Not IsError(result) Then
For i = 1 To 5
If (result - i) > 0 Then
If (Left(Trim(rData(result - i, 1)), 3) = "418") Then
MsgBox "customer: " & r & ". invoice: " & rData(result - i, 1)
End If
End If
Next
For i = 1 To 15
If (result + i) > 0 Then
If (Left(Trim(rData(result + i, 1)), 3) = "418") Then
MsgBox "customer: " & r & ". invoice: " & rData(result + i, 1)
End If
End If
Next
End If
Next r
End Sub
Only part of this that is giving me a headache is this part result = Application.Match(r, rData, 0). How do it get match for not exact match?
Sample of Sheet1
This is what more or less looks like. Matching after CustomerNumber# is easy because they are the same every invoice. BUT sometimes invoice does not have it so I'm searching after CustomerName and sometimes they have uppercase letters, sometimes there is extra stuff behind it and therefore it cannot find exact match.
Hope it makes sense.
To match the customer name from your customer list to the customer name in the invoice even if it has extra characters appended, you can use the wildcard * in Match().
You also have a typo in the Match() function. r20 should be rData.
This is your code with the fixes applied:
Sub Test()
'v4
Dim rData As Variant
Dim r As Variant
Dim r20 As Variant
Dim result As Variant
Dim i As Long
rData = ActiveWorkbook.Sheets(2).Range("A1:A60000")
r20 = ActiveWorkbook.Sheets(1).Range("C2:C33")
For Each r In r20
result = Application.Match(r & "*", rData, 0) ' <~ Fixed here
If Not IsError(result) Then
For i = 1 To 5
If (result - i) > 0 Then
If (Left(Trim(rData(result - i, 1)), 3) = "418") Then
MsgBox "customer: " & r & ". invoice: " & rData(result - i, 1)
End If
End If
Next
For i = 1 To 15
If (result + i) > 0 Then
If (Left(Trim(rData(result + i, 1)), 3) = "418") Then
MsgBox "customer: " & r & ". invoice: " & rData(result + i, 1)
End If
End If
Next
End If
Next r
End Sub
Notes:
Match() is case insensitive, so it works with different capitalisations.
The data in Sheets(2) must all be text for Match() to work correctly with wildcards.
EDIT1: New better version
EDIT2: Refactored constants and made data ranges dynamic
EDIT3: Allows for any prefix to an invoice number of a fixed length
The following is a better, rewritten version of your code:
Sub MuchBetter()
'v3
Const s_InvoiceDataWorksheet As String = "Sheet2"
Const s_InvoiceDataColumn As String = "A:A"
Const s_CustomerWorksheet As String = "Sheet1"
Const s_CustomerStartCell As String = "C2"
Const s_InvoiceNumPrefix As String = "418"
Const n_InvoiceNumLength As Long = 8
Const n_InvScanStartOffset As Long = -5
Const n_InvScanEndOffset As Long = 15
Dim ƒ As Excel.WorksheetFunction: Set ƒ = Excel.WorksheetFunction ' Shortcut
With Worksheets(s_InvoiceDataWorksheet).Range(s_InvoiceDataColumn)
With .Parent.Range(.Cells(1), .Cells(Cells.Rows.Count).End(xlUp))
Dim varInvoiceDataArray As Variant
varInvoiceDataArray = ƒ.Transpose(.Cells.Value2)
End With
End With
With Worksheets(s_CustomerWorksheet).Range(s_CustomerStartCell)
With .Parent.Range(.Cells(1), .EntireColumn.Cells(Cells.Rows.Count).End(xlUp))
Dim varCustomerArray As Variant
varCustomerArray = ƒ.Transpose(.Cells.Value2)
End With
End With
Dim varCustomer As Variant
For Each varCustomer In varCustomerArray
Dim dblCustomerIndex As Double
dblCustomerIndex = Application.Match(varCustomer & "*", varInvoiceDataArray, 0)
If Not IsError(dblCustomerIndex) _
And varCustomer <> vbNullString _
Then
Dim i As Long
For i = ƒ.Max(dblCustomerIndex + n_InvScanStartOffset, 1) _
To ƒ.Min(dblCustomerIndex + n_InvScanEndOffset, UBound(varInvoiceDataArray))
Dim strInvoiceNum As String
strInvoiceNum = Right$(Trim$(varInvoiceDataArray(i)), n_InvoiceNumLength)
If (Left$(strInvoiceNum, Len(s_InvoiceNumPrefix)) = s_InvoiceNumPrefix) Then
MsgBox "customer: " & varCustomer & ". invoice: " & strInvoiceNum
End If
Next
End If
Next varCustomer
End Sub
Notes:
It is a good idea to use constants so all literal values are typed once only and kept grouped together.
Using the RVBA naming convention greatly increases the readability of the code, and reduces the likelihood of bugs.
Using long, appropriately named variables makes the code essentially self-documenting.
Using .Value2 whenever reading cell values is highly recommended (it avoids implicit casting, making it slightly faster as well as eliminating certain issues caused by the casting ).
Surprisingly, in VBA there are good reasons to put a variable declaration as close as possible to the first use of the variable. Two such reasons are 1) it improves readability, and 2) it simplifies future refactoring. Just remember that the variable is not reinitialised every time the Dim is encountered. Initialisation only occurs the first time.
The twin loops have been rolled into one according to the DRY principle.
Whilst the check for an empty customer name/number is not strictly necessary if you can guarantee it will never be so, it is good defensive programming as an empty value will cause erroneous results.
The negative index check inside the loop has been removed and replaced with the one-time use of the Max() worksheet function in the For statement.
The Min() worksheet function is also used in the For statement to avoid trying to read past the end of the array.
Always use worksheet functions on the WorksheetFunction object unless you are explicitly checking for errors, in which case use the Application object.
I have the following data set, which contains duplicates.
values:
2880CR-20.36KX53305DECOAK2015
F05572-CN48517OCTOAK2016
F05572-CN48517DECOAK2016
F05572-CN48517NOVOAK2015
F05572-CN48517NOVOAK2015(duplicate)
F05572-CN48517DECOAK2015
F05573-CN48517JANOAK2016
F05573-CN48517FEBOAK2016
F05573-CN48517JANOAK2015
F05573-CN48517FEBOAK2015
F05573-CN48517MAROAK2015
F05573-CN48517APROAK2015
F05573-CN48517APROAK2015(duplicate)
I am trying to create a macro that will look at the values in column A, from A2:A (count of rows in column), and return a list of the duplicate values contained in the string declared "strMyDupList". Basically, if there is atleast 1 duplicate, the msgbox will pop up and the new sheet created with the columns address and values and I am trying to list out all the values seperated my a comma VERTICALLY, instead of horizontally across the sheet. so like:
Address value
$A$5 F05572-CN48517NOVOAK2015
$A$13 F05573-CN48517APROAK2015
my code is :
If strMyDupList <> "" Then
MsgBox "The following entries have been used more than once:" & vbNewLine & strMyDupList
Worksheets.Add.name = name
Worksheets(name).Range("A1").Value = "Location"
Worksheets(name).Range("B1").Value = "Value"
' Worksheets(name).Range("A2:C2").Value = Split(strMyDupList, ",")
Worksheets(name).Range("B4:B6") = Split(Application.WorksheetFunction.Transpose(strMyDupList), ",")
The results are that I am able to get the values tranposed from horizontal to vertical, however, with this code, it is only returning the FIRST VALUE in the list of values in the string, so it's returning:
Address value
$A$5 F05572-CN48517NOVOAK2015
$A$5 F05572-CN48517NOVOAK2015 (should be F05573-CN48517APROAK2015)
I've seen the UBound with Resize could work but I have no idea how the syntax works or is used. Can someone assist?
Thank you
Here is a complete example of how to leave duplicates out of your information.
Essentially, it sorts all of your information. Therefore, when you sort you'll get the consecutive value which would be itself if it was a dupe.
It uses a .NET feature, System.Collections.ArrayList, that was in 2.0 & 3.5 so that has to be installed on your machine. Usually it already is but it may not be. You can turn it on through Programs & Features.
Sub StringArrayDupeChecker()
Dim var As Variant
Dim holder As String
Dim strMyList() As String
Dim myDupeData As Variant
Dim str As String
str = "one,two,three,three,three,four,five,five"
strMyList = Split(str, ",")
holder = ""
Set var = CreateObject("System.Collections.ArrayList")
Set myDupeData = CreateObject("System.Collections.ArrayList")
For Each i In strMyList
var.Add (i)
Next i
var.Sort
For Each j In var
If Not j = holder Then
'do your stuff
str = "notDupe"
Else
myDupeData.Add(j)
End If
holder = j
Next j
End Sub
I have block of code where I'm using a For... Next loop to go through an Excel sheet, and tell me if values entered in the text boxes were found or not. I've modified it to work if the values match. Yet, I'm receiving the Object/With Block variable not set error, and it confusing me. I've created the following:
Dim Value2Find_1 As String = txtMachNumber.Text 'Serial number value.
Dim Value2Find_2 As String = txtMachName.Text 'Machine name value.
Dim ReplaceWithValue1 As String = "" 'Replaces the serial number value if found in the sheet.
Dim ReplaceWithValue2 As String = "" 'Replaces the machine name value if found in the sheet.
Dim ReplaceWithValue3 As String = "" 'Replacement for the date-time in the Date Column.
Dim Range2Use_1 = xlWS.Range("A1:A4000") 'Range to span the A Column.
Dim Range2Use_2 = xlWS.Range("B1:B4000") 'Range to span the B Column.
Dim Range2Use_3 = xlWS.Range("F1:F4000") 'Range to span the F Column.
Dim xlCell_A = Range2Use_1.Find(txtMachNumber.Text) 'Looks up the searched serial value in A Column.
Dim xlCell_B = Range2Use_2.Find(txtMachName.Text) 'Looks up the searched machine value in B Column.
Dim LastRow = xlWS.Range("A4000").End(Excel.XlDirection.xlUp).Row + 1
Dim i As Integer
With xlWS
For i = 1 To LastRow
If Not (Value2Find_1 = txtMachNumber.Text And Value2Find_2 = txtMachName.Text) Then
MessageBox.Show("No value exists here...")
Else
Range2Use_1.Find(What:=Value2Find_1, MatchCase:=True)
Range2Use_2.Find(What:=Value2Find_2, MatchCase:=True)
MsgBox("Found both values: " & Value2Find_1 & " and " & Value2Find_2 & " on row " & xlCell_A.Row)
End If
Exit Sub
Next
End With
If my textbox entries are not in the sheet, the errors returns on the following line of code:
MsgBox("Found both values: " & Value2Find_1 & " and " & Value2Find_2 & " on row " & xlCell_A.Row)
I've narrowed it down to have something to do with the variable that returns the row number of the located textbox entries - xlCell_A. This is where I'm stuck, however. What do I need to set this as in order to avoid the Object/With Block variable not set error? I am afraid I don't know what this is asking for.
I think the problem with your code is that the Find method returns Nothing whenever no match is found, as stated in its documentation. Thus, xlCell_A.Row returns the error because the Row method cannot be called on Nothing.
Actually, I see a number of further issues with your code:
The interior of the for loop does not depend on the loop variable i. Hence, it does exactly the same thing in each interation.
The variable xlWS of the With block is never used, which makes the With block unnessesary.
The return values of the Find methods in the loop never gets assigned to anything. Because of this, they have no effect.
The condition in the if statement always returns False since you never change the values of Value2Find_1 and Value2Find_2 and you initialized them to txtMachNumber.Text and txtMachName.Text, respectively.
If you intend to evaluate whether the values txtMachNumber.Text and txtMachName.Text are present in the column A and B, respectively, you can just test whether xlCell_A and xlCell_B are Nothing.
Since you want to find both on the same row, which using Find does not guarantee, it might be easier to use a loop as in your code but replace
txtMachNumber.Text and txtMachName.Text with Range2Use_1.Cells(i,1) and Range2Use_2.Cells(i,1) in the if statement. (This compares the value in the ith row with the values to search for.) Obviously, you would have to exit the loop after finding a match, e.g. using the break statement.
I am trying to write a code that reads in multiple entities, catorgorizes and sorts them. Each entity has a type (A, B, C, etc.) that should determine what sheet it gets put into and all of them get put into my "All" sheet. Each time I find an entity of any given type I'd also like to increment a variable specific to that type.
What I'd like to do if find the type and do two things:
Set the current sheet to that type.
Set the counter variable to that type.
Example:
Dim x As Integer, FindSlot As Integer
Dim CurrentSheet As String, CurrentPropertyNumb As String
Dim APropertyNumb As String, BPropertyNumb As String
Dim CPropertyNumb As String
For x = 1 to 2
If x = 1 Then
CurrentSheet = "All"
Else
CurrentSheet = Range("B" & FindSlot)
CurrentPropertyNumb = CurrentSheet & PropertyNumb
End If
Next x
In the else block, CurrentSheet will get set to "A", "B", "C" or whatever the type is. Then I'd like CurrentPropertyNumb to get set to "APropertyNumb" or "BPropertyNumb" etc. Obviously I could do this with several If statements but it would end up being 12 of them which I'd rather avoid plus I think this would be cool! :)
Is there any way to do this or am I being too lofty with my goals?
If you have a series of values which you'd like to index using a string value then a Dictionary is a good fit:
Dim x As Integer, FindSlot As Integer
Dim CurrentSheet As String, CurrentPropertyNumb As String
Dim PropNums as Object
Dim CPropertyNumb As String
Set PropNums = CreateObject("scripting.Dictionary")
For x = 1 to 2
If x = 1 Then
CurrentSheet = "All"
Else
CurrentSheet = Range("B" & FindSlot)
If Not PropNums.Exists(CurrentSheet) Then
PropNums.Add CurrentSheet, 1 '? what are the initial values here?
Else
PropNums(CurrentSheet) = PropNums(CurrentSheet) +1
End If
CurrentPropertyNumb = PropNums(CurrentSheet)
End If
Next x
I'm using the code below to separate a group of strings separated by a comma (,), then saves the output in a string variable named, msg. Strings in variable msg is separated by vbNewLine.
For example:
Original string for example is fruits, contains: apple, mango, orange
after applying the function splittext(fruits)
the variable now msg contains: apple <vbNewLine> mango <vbNewLine> orange
Now, I wanted to separate the content of this msg to cell(each string).
For example, mango is in A1, apple is in A2, orange is in A3 (on a different sheet.
I tried 'ActiveWorkbooks.Sheets("Sheet2").Range("A" & i).Value = Cs(i), (see the code below). But it's not working. After the execution, the cells in the sheet2 remains unchanged. I really need your help. Thanks.
Function splittext(input_string As String) As String
Dim SptTxt As String
Dim Cs As Variant
Dim CsL As Byte
Dim CsU As Byte
Dim i As Byte
Dim col As Collection
Set col = New Collection
Cs = Split(input_string, ",")
CsL = LBound(Cs)
CsU = UBound(Cs)
Dim msg As String
For i = CsL To CsU
ReDim arr(1 To CsU)
col.Add Cs(i)
msg = msg & Cs(i) & vbNewLine
'ActiveWorkbooks.Sheets("Sheet2").Range("A" & i).Value = Cs(i)
Next
splittext = msg
End Function
Here's your macro refactored to give the results you describe, without any looping.
Function splittext(input_string As String) As String
Dim Cs As Variant
Cs = Split(input_string, ",")
splittext = Join(Cs, vbNewLine)
' Put results into workbook
With ActiveWorkbook.Sheets("Sheet2")
Range(.[A1], .Cells(UBound(Cs) + 1, 1)).Value = Application.Transpose(Cs)
End With
End Function
Note that copying an array to a range requires a 2 dimensional array, rows x columns. Transpose is a handy function to convert a 1 dim array to a 2 dim array
EDIT
Note that if you call this as a user-defined function (UDF) from a cell (as you are in the sample file) it will fail (If it is called from a VBA Sub it will work). This is because a UDF cannot modify anything in Excel, it can only return to the calling cell (there is a rather complex workaround, see this answer.) If you remove the With section it does work as a UDF.
If what you are trying to return the list into multiple cells, consider using an array function.
You have to use it like that:
ActiveWorkbook.Sheets("Sheet2").Range("A" & i+1).Value = Cs(i)
You try to write in the Cell "A0" because "i" is in the First loop zero. And this is not working because there is no cell "A0".
And you had an "s" by ActiveWorkbook.
Moosli