Vlookup in VBA from different sheets - coding error - excel

i am new to VBA. I got this code but when it runs, it shows this error message :
Wrong number of argument or invalid property assignment.
This is my code when i copied it from somewhere and editing myself :
Sub cl_macro2()
cl_macro2 macro '
Dim Concur As Worksheet, SunAccCode As Worksheet
Dim ConcurLastRow As Long, SunAccCodeLastRow As Long, x As Long
Dim SunAccCodeRng As Range
Set Concur = ThisWorkbook.Worksheets("Concur")
Set SunAccCode = ThisWorkbook.Worksheets("SunAccCode")
ConcurLastRow = Concur.Range("I" & Rows.Count).End(xlUp).Row
SunAccCodeLastRow = SunAccCode.Range("A" & Rows.Count).End(xlUp).Row
Set SunAccCodeRng = SunAccCode.Range("A1:C" & SunAccCodeLastRow)
For x = 2 To ConcurLastRow
On Error Resume Next
Concur.Range("J" & x).Value = Application.WorksheetFunction.VLookup(Concur.Range("I" & x).Value, SunAccCodeRng, 3, 0)
Next x
End Sub

The second line of your code reads:
cl_macro2 macro '
This appears to be a (meaningless) comment, but without the apostrophe at the beginning of the line telling VBA not to execute it.
What's actually happening is that VBA is trying to execute this line as if it were code. As written, it means the sub is trying to call itself - and pass an argument (variable) called "macro". But since the sub doesn't take any arguments, you get an error.
For a comment, you need to insert a ' like this:
' cl_macro2 macro '
Otherwise, just delete the whole line.

Related

Named non-contiguous range cannot referred to via Name.RefersToRange - why & how to overcome (elegantly)?

I got stumped by a rather weired behaviour of Excel (tested on Office Pro 2016 and Office 365).
It appears as if Name.RefersToRange breaks when referring to a non-contiguous range.
See this test procedure
Public Sub test()
Dim n As Name
With ActiveWorkbook
For Each n In .Names ' remove all preexisting names
n.Delete
Next n
Call .Names.Add("rPass", "=Sheet1!$A$1:$C$3") ' create a new contiguous named range
Call .Names.Add("rFail", "=Sheet1!$A$1,Sheet1!$C$3") ' create a new non-contigous named range
Debug.Print .Names("rPass").RefersTo ' runs fine Output: =Sheet1!$A$1:$C$3
Debug.Print .Names("rPass").RefersToRange.Address ' runs fine Output: $A$1:$C$3
Debug.Print .Names("rFail").RefersTo ' runs fine Output: =Sheet1!$A$1,Sheet1!$C$3
Debug.Print .Names("rFail").RefersToRange.Address ' crashes with Error 1004
End With
End Sub
I found a clumsy workaround like this
Public Function FunkyRefersToRange(rng As Name) As Range
Dim r As Range
Set r = Range(Mid(rng, 2)) ' create a local range by stripping the leading equal sign of the reference
Set FunkyRefersToRange = r
End Function
With that you can now write (as long the correct worksheet is selected)
Debug.Print FunkyRefersToRange(.Names("rFail")).Address
But I'd like to understand why non-contiguous ranges cannot be referenced via Name.RefersToRange and how to overcome that limitation more elegantely than shown above.
It should work like this:
Sub WhatsInaName()
Dim disJoint As Range, N As Name, addy As String
Set disJoint = Range("A1,B9")
disJoint.Name = "jim"
Set N = disJoint.Name
addy = N.RefersToRange.Address
MsgBox disJoint.Address & vbCrLf & addy
End Sub
Can you replicate my result on your computer?

Excel VBA Run time Error 424: Object Required

I am totally new in VBA and coding in general, I'm trying to get data from cells from the same workbook if the condition is met to paste in another book.
I am getting this error when trying to get values entered in excel cells:
Run Time Error '424' object required
When I'm pressing the debug button it takes to the first line and highlights it. I am not able to recognize why it is happening? Also when in watch window it shows a=0.
The code is
Sub copycells()
a = ThisWorkbook.Worksheets("Sale").Cells(Row.Count, 2).End(xlUp).Row
For i = 2 To a
If Worksheets("Sale").Cells(i, 6).Value = "Parmesh" Then
Worksheets("Sale").Row(i).copy
Workbooks("Source.xlsx").Worksheets("Billdetails").Activate
b = Workbooks("Source.xlsx").Worksheets("Billdetails").Cells(Row.Count, 2).End(xlUp).Row
Workbooks("Source.xlsx").Worksheets("Billdetails").Cells(b + 1, 1).Select
ActivateSheet.Paste
Worksheets("Sale").Activate
End If
Next
Application.CutCopyMode = False
Workbooks("Purchase.xlsx").Worksheets("Sale").Cells(1, 1).Select
End Sub
Option Explicit: Your Friend
That should teach you to always use Option Explicit. If you had been using it the following might have happened (Compile error: Variable not defined):
After OK:
you see that something is wrong with Row.
After changing to Rows another Compile error: Variable not defined. After OK:
you see that something is wrong with a =.
After adding Dim a As Long another Compile error: Variable not defined. After OK:
you see that something is wrong with i.
After adding Dim i As Long another Compile error: Variable not defined. After OK:
You see something is wrong with Row again.
After changing to Rows another Compile error: Variable not defined. After OK:
you see that something is wrong with b =.
After adding Dim b As Long another Compile error: Variable not defined. After OK:
you see that something is wrong with ActivateSheet.
After changing to ActiveSheet finally a Run-time error:
and after Debug:
Row looks suspicious again.
After changing to Rows another Run-time error:
and after Debug:
you see that something is wrong with ActiveSheet.Paste, especially Paste.
After changing to ActiveSheet.PasteSpecial another Run-time error:
and after Debug:
you see something is wrong with Worksheets("Sale").Activate.
Since Source.xlsx is active you consider changing to Workbooks("Purchase.xlsx").Worksheets("Sale").Activate and everything's finally OK. Or is it?
The Code
Option Explicit
Sub copycells()
Dim a As Long
Dim b As Long
Dim i As Long
With ThisWorkbook.Worksheets("Sale")
a = .Cells(.Rows.Count, 2).End(xlUp).Row
For i = 2 To a
If .Cells(i, 6).Value = "Parmesh" Then
.Rows(i).Copy
With Workbooks("Source.xlsx").Worksheets("Billdetails")
b = .Cells(.Rows.Count, 2).End(xlUp).Row
.Cells(b + 1, 1).PasteSpecial
End With
End If
Next
' If Purchase.xlsx and ThisWorkbook are the same then use the following:
'.Cells(1).Select
End With
Application.CutCopyMode = False
' If Purchase.xlsx and ThisWorkbook are not the same then use the following:
'Workbooks("Purchase.xlsx").Worksheets("Sale").Cells(1, 1).Select
End Sub
' Assuming that you need only values and that "Thisworkbook" is "Purchase.xlsx"
Sub copyCellsValues()
Const SourceBook As String = "Source.xlsx"
Const SourceSheet As String = "Billdetails"
Const MainSheet As String = "Sale"
Const MainColumn As Long = 6
Const Criteria As String = "Parmesh"
Dim Sale As Worksheet
Dim Bill As Worksheet
Dim a As Long
Dim b As Long
Dim i As Long
Set Sale = ThisWorkbook.Worksheets(MainSheet)
Set Bill = Workbooks(SourceBook).Worksheets(SourceSheet)
a = Sale.Cells(Sale.Rows.Count, 2).End(xlUp).Row
b = Bill.Cells(Bill.Rows.Count, 2).End(xlUp).Row + 1
For i = 2 To a
If Sale.Cells(i, MainColumn).Value = Criteria Then
Bill.Rows(b).Value = Sale.Rows(i).Value
b = b + 1
End If
Next
End Sub
First of all, it seems you need to declare missed variable:
Sub copycells()
Dim a as Integer
Dim b as Integer
a = ThisWorkbook.Worksheets("Sale").Cells(Row.Count, 2).End(xlUp).Row
For i = 2 To a
If Worksheets("Sale").Cells(i, 6).Value = "Parmesh" Then
Worksheets("Sale").Row(i).copy
Workbooks("Source.xlsx").Worksheets("Billdetails").Activate
b = Workbooks("Source.xlsx").Worksheets("Billdetails").Cells(Row.Count, 2).End(xlUp).Row
Workbooks("Source.xlsx").Worksheets("Billdetails").Cells(b + 1, 1).Select
ActivateSheet.Paste
Worksheets("Sale").Activate
End If
Next
Application.CutCopyMode = False
Workbooks("Purchase.xlsx").Worksheets("Sale").Cells(1, 1).Select
End Sub
Also, you may try to use the Set operator.
Anyway, it is not clear what property or method gives an error. So, I'd recommend breaking the chain of property and method calls:
a = Workbooks("Purchase.xlsx").Worksheets("Sale").Cells(Rows.Count, 2).End(xlUp).Row
Just declare separate lines of code where a single property or method will take its place. For example:
Dim workbk as Excel.Workbook
Dim worksht as Excel.Worksheet
Set workbk = Workbooks("Purchase.xlsx")
Set worksht = workbk.Worksheets("Sale")
Following that way, you will be able to find the problematic call.

Excel VBA Find Duplicates and post to different sheet

I keep having an issue with some code in VBA Excel was looking for some help!
I am trying to sort through a list of names with corresponding phone numbers, checking for multiple names under the same phone number. Then post those names to a separate sheet.
So far my code is:
Sub main()
Dim cName As New Collection
For Each celli In Columns(3).Cells
Sheets(2).Activate
On Error GoTo raa
If Not celli.Value = Empty Then
cName.Add Item:=celli.Row, Key:="" & celli.Value
End If
Next celli
On Error Resume Next
raa:
Sheets(3).Activate
Range("a1").Offset(celli.Row - 1, 0).Value = Range("a1").Offset(cName(celli.Value) - 1, 0).Value
Resume Next
End Sub
When I try to run the code it crashes Excel, and does not give any error codes.
Some things I've tried to fix the issue:
Shorted List of Items
Converted phone numbers to string using cstr()
Adjusted Range and offsets
I'm pretty new to all this, I only managed to get this far on the code with help from other posts on this site. Not sure where to go with this since it just crashes and gives me no error to look into. Any ideas are appreciated Thank you!
Updated:
Option Explicit
Dim output As Worksheet
Dim data As Worksheet
Dim hold As Object
Dim celli
Dim nextRow
Sub main()
Set output = Worksheets("phoneFlags")
Set data = Worksheets("filteredData")
Set hold = CreateObject("Scripting.Dictionary")
For Each celli In data.Columns(3).Cells
On Error GoTo raa
If Not IsEmpty(celli.Value) Then
hold.Add Item:=celli.Row, Key:="" & celli.Value
End If
Next celli
On Error Resume Next
raa:
nextRow = output.Range("A" & Rows.Count).End(xlUp).Row + 1
output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
'data.Range("B1").Offset(celli.Row - 1, 0).Value = Range("B1").Offset(hold
Resume Next
End Sub
Update2:
Used hold.Exists along with an ElseIf to remove the GoTo's. Also changed it to copy and paste the row to the next sheet.
Sub main()
Set output = Worksheets("phoneFlags")
Set data = Worksheets("filteredData")
Set hold = CreateObject("Scripting.Dictionary")
For Each celli In data.Columns(2).Cells
If Not hold.Exists(CStr(celli.Value)) Then
If Not IsEmpty(celli.Value) Then
hold.Add Item:=celli.Row, Key:="" & celli.Value
Else
End If
ElseIf hold.Exists(CStr(celli.Value)) Then
data.Rows(celli.Row).Copy (Sheets("phoneFlags").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0))
'output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
End If
Next celli
End Sub
When developing code, don't try (or be afraid of) errors as they are pointers to help fix the code or the logic. As such, don't use On Error unless it is absolutely indicated in the coding algorithm (*). using On Error when not necessary only hides errors, does not fix them and when coding it is always better to avoid the errors in the first place (good logic).
When adding to the Dictionary, first check to see if the item already exists. The Microsoft documentation notes that trying to add an element that already exists causes an error. An advantage that the Dictionary object has over an ordinary Collection object in VBA is the .exists(value) method, which returns a Boolean.
The short answer to your question, now that I have the context out of the way, is that you can first check (if Not hold.exists(CStr(celli.Value)) Then) and then add if it does not already exist.
(*) As a side note, I was solving an Excel macro issue yesterday which took me most of the day to nut out, but the raising of errors and the use of debugging code helped me make some stable code rather than some buggy but kind-of-working code (which is what I was fixing in the first place). However, the use of error handling can be a short cut in some instances such as:
Function RangeExists(WS as Worksheet, NamedRange as String) As Boolean
Dim tResult as Boolean
Dim tRange as Range
tResult = False ' The default for declaring a Boolean is False, but I like to be explicit
On Error Goto SetResult ' the use of error means not using a loop through all the named ranges in the WS and can be quicker.
Set tRange = WS.Range(NamedRange) ' will error out if the named range does not exist
tResult = True
On Error Goto 0 ' Always good to explicitly limit where error hiding occurs, but not necessary in this example
SetResult:
RangeExists = tResult
End Function

Generic function procedure working with different workbooks

I am trying to get better coding practice and using generic function.
I am working with several workbooks from a master file.
For example if I want to get the last row I am using the following line of code.
LastRow=Range("A" & Rows.Count).End(xlUp).Row
To retrieve the value with a function I build the function:
-Function 1
Function GetLastRow() As Integer
GetLastRow = Range("A" & Rows.Count).End(xlUp).Row
End Function
Now from my Sub Main() I want to use GetLastRow() for different workbooks or worksheets. I think it is not a good thing to Activate the workbook before calling my function.
Then should I transmit each time the workbook name and worksheet number to my function and change my function to:
-Function 2
Function GetLastRowIn(sWb As String, iWs As Integer) As Integer
GetLastRowIn = Workbooks(sWb).Worksheets(iWs).Range("A" & Rows.Count).End(xlUp).Row
End Function
Or is there a better/simpler way to transmit the workbook and worksheet in which I want to apply the function while keeping it with no argument as in Function 1?
Thanks for your answers!
To make a function more generic you can allow for some flexibility,
but also impose some rulles for the function calls
Generic Function
Option Explicit
Public Function GetLastRow(ByRef ws As Worksheet, Optional ByVal fromCol As Long = 1) As Long
Dim invalidWS As Boolean, lastRow As Long
If Not ws Is Nothing Then 'check 1st param
On Error Resume Next 'check that ws reference is valid (delted WS invalidates ws)
invalidWS = Len(ws.Name) > 0
invalidWS = Err.Number <> 0 'No error if Err.Number = 0
On Error GoTo 0
If Not invalidWS Then
If fromCol > 0 And fromCol <= ws.Columns.Count Then 'validate 2nd param
lastRow = ws.Cells(ws.Rows.Count, fromCol).End(xlUp).Row
'check if WS.fromCol is empty
If lastRow = 1 And Len(ws.Cells(1, fromCol)) = 0 Then lastRow = 0
End If
End If
End If
GetLastRow = lastRow
End Function
Test Sub
Public Sub TestGetLastRow()
'show results in the Immediate Window (VBA Editor: Ctrl+G)
Debug.Print GetLastRow(Sheet1, 1) 'CodeName of WS
Debug.Print GetLastRow(Workbooks(1).Worksheets(1)) 'WS Index
Debug.Print GetLastRow(ActiveWorkbook.Worksheets("Sheet3"), 3) 'WS name (string)
Debug.Print GetLastRow(ThisWorkbook.Worksheets(1), 0) 'invalid column (or -3)
Dim ws As Worksheet
Set ws = Sheet3
Application.DisplayAlerts = False
ws.Delete 'invalidate ws variable
Application.DisplayAlerts = True
Debug.Print GetLastRow(ws, 1) 'function call with invalid ws object
End Sub
Always use Option Explicit to allow the compiler to catch spelling mistakes in variable names
Validate all input
The function call may not include a valid Worksheet, or column number
Allow the Worksheet to be specified by CodeName, WS Index, or WS Name (string)
Allow a default column ID by using Optional for the 2nd parameter
Impose the call to send only a Worksheet object as the first parameter
If you accept strings for it you need to first check that Worksheet("Invalid") exists
Impose the call to request column by Index
If you allow strings in column ID you need to check that the string is between "A" and "XFD"
String length between 1 and 3, and also not allow strings like "XYZ"
This would require a separate function that checks each letter in the string
Strings also create potential for more maintenance if MS decides to increase max columns
Make the function for one purpose (like you did) - don't include other functionality later on
The function should be self contained
Able to detect and handle all possible errors and unexpected input
And generate the most generic and usable output
By returning a 0 in this particular function, calls that expect a valid number will error out for row 0
So you may want to change it to return 1 even if the sheet is empty
and check the top cell if blank after the call returns
As a note:
several workbooks from a master file
A Workbook is a file
A Worksheet is a tab inside a file (a file can contain multiple sheets / tabs)
Always be explicit with all object
Range("A" & Rows.Count).End(xlUp).Row implicitly uses ActiveWorkbook.ActiveSheet
Translates to ActiveWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
If you need to work with several Workbooks and Worksheets, fully qualify your calls
`Workbooks("Book1").Worksheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Row
`Workbooks("Book2").Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
so Excel can access the exact object you need to work with
If you use full references your code doesn't depend on active objects
- If a user activates a different Workbook, or Worksheet the code will continue to work without errors
Hope this helps
PS. When using row variables always declare them as Long to be able to handle more than the Integer maximum of 32,767 - currently Excel has a max of 1,048,576 rows (in the future this max can increase even higher)

Automation Error -2147221080 (800401a8)

Im intending to conduct a VBA macro which returns the cell value of C34 of the file referenced by path which has the sheet names as presented in myHeadings.
Sub Test()
Dim myHeadings() As String
Dim i As Long
Dim path As String
path = "C:\pathtofile\file.xlsx"
Dim currentWb As Workbook
Set currentWb = ActiveWorkbook
Dim openWb As Workbook
Set openWb = Workbooks.Open(path)
Dim openWs As Worksheet
myHeadings = Split("Januari,Februari,Mars", ",")
For i = 0 To UBound(myHeadings)
Set openWs = openWb.Sheets(myHeadings(i))
currentWb.Sheets("Indata").Range("AA" & 73+Application.Match (myHeadings(i),Array,False)).Value = openWs.Range("C34").Value
Next i
End Sub
This however gives the error message: Automation Error -2147221080 (800401a8) at the code snippet:
currentWb.Sheets("Indata").Range("AA73+Application.Match (i,Array,False)").Value = openWs.Range("C34").Value
I'm new to VBA and am yet to create a macro actually runable, so the cause may be trivial. From googling I'm yet to find a solution to this specific problematic.
EDITED some code to remove "Array" and updated t
I think you want this:
currentWb.Sheets("Indata").Range("AA" & 73 + Application.Match(i,Array,False)) = openWs.Range("C34")
If the result of
Application.Match(i,Array,False)
is equal to 1, you want to make AA74 to equal whatever is in openws.Range("C34"), right?
'&' is a concatentation character, so what we are saying above is that we take "AA" then calculate 73 + 1 and concatenate it to the end. The bit you were missing is escaping the text after the "AA" to do the numerical calculation.
EDIT:-
After reading Aiken's comments above, I believe your answer should be to remove the Match function entirely:
currentWb.Sheets("Indata").Range("AA" & 73 + i + 1).Value = openWs.Range("C34").Value

Resources