I'm having a problem where moving a VLookup function from a Cell to a Macro is returning #N/A.
Right now, I have a table that is referencing a second, unformatted table to build a formatted list. The formatted list uses a series of VLOOKUP commands to populate, but this requires manually entering a new line and the 'SubPart' name.
I'm writing a macro that will simply read the whole source table and populate thew new formatted one with a single click.
Unfortunately, I can't seem to get VLOOKUP to work when it's taken from cells to a macro.
Sub PopulateSubs()
On Error GoTo MyErrorHandler:
Dim SubAssy, SubPart As String
Dim BomCount, i As Integer
Dim BlankRow As Long
Dim Source_Table As ListObject
Set Source_Table = Worksheets("BoMs").ListObjects("Table_Query_From_Syspro")
SubAssy = InputBox("Enter the Subassembly:")
If Len(SubAssy) > 0 Then
BomCount = Application.CountIf(Range("Table_Query_from_Syspro[ParentPart]"), SubAssy)
For i = 1 To BomCount
BlankRow = Range("A10000").End(xlUp).Row + 1
Cells(BlankRow, 1).Select
SubPart = SubAssy & i
ActiveCell = i
ActiveCell.Offset(0, 1).Select
ActiveCell = Application.WorksheetFunction.VLookup(SubPart, Source_Table, 2, 0)
ActiveCell.Offset(0, 1).Select
ActiveCell = Application.WorksheetFunction.VLookup(SubPart, Source_Table, 3, 0)
Next i
Else
MsgBox "You entered an invalid value"
End If
MyErrorHandler:
If Err.Number = 1004 Then
MsgBox "Sub assembly Not Present in the table."
End If
End Sub
VLOOKUP in the manual table was correctly working, but I cannot get it to return anything but #N/A in this application.
I have looked at similar solutions on this site, and run the macro with SubPart as "SubPart" as well as ""SubPart"" but neither term seems to help.
The source table is formatted as General for all cells, I'm not sure if this causes a type mismatch with String entries.
Thanks!
This works fine
...Application.WorksheetFunction.VLookup(SubPart, Application.Range("Source_Table"), 6, False)
The way you call the vlookup doesn't work is because it is a member of Worksheetfunction, try;
Application.Worksheetfunction.VLookup
This applies to most excel formulas. There are some functions that are embedded in vba like min/max/now and do not specifically have to be called through the Worksheetfunction member.
Related
I am very new to VBA and have been teaching myself for the last week. I have taken on a task that is maybe a bit to complex for me.
I have a document with columns A - AE
I need to go through this document and move information on to separate sheets, depending on what it is.
I am now trying to use an IF statement that needs to match 2 requirements before it moves the information. I can get each individual requirement to work but not both together as keep getting a Type Mismatch error.
I have no idea what i am doing wrong. Any help will be much appreciated.
Sub copyrows()
Dim Test As Range, Cell As Object
Set Test = Range("G2:Z4000") 'Substitute with the range which includes your True/False values
For Each Cell In Test
If IsEmpty(Cell) Then
Exit Sub
End If
If Cell.Value = "Refund" And "Commission" Then
Cell.EntireRow.Copy
Sheet3.Select 'Substitute with your sheet
ActiveSheet.Range("A65536").End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If
Next
End Sub
If Cell.Value = "Refund" And "Commission" Then
Should instead read:
If Cell.Value = "Refund" Or Cell.Value = "Commission" Then
You have to be explicit with each condition separated by boolean operators like AND or OR.
The reason for your error is already mentioned in the answer above by #IanL
However, your code is far from being optimized.
You can replace your 5 lines:
Cell.EntireRow.Copy
Sheet3.Select 'Substitute with your sheet
ActiveSheet.Range("A65536").End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
With 1:
Cell.EntireRow.Copy Destination:=Sheet3.Range("A65536").End(xlUp).Offset(1)
Which is not using Select, ActiveSheet, or Selection, just using fully qualified Range object.
I have the following formula:
dim functionString as String
functionString = "IFERROR(AND(MATCH(" & FirstName.Value & ",C2:C1048576, 0)>0, (MATCH(" & LastName.Value & ",B2:B1048576, 0)>0)), MAX(A2:A1048576)+1)"
What I want to be able to do is call it from the VBA code so it would look like.
application.WorksheetFunction(functionString)
I know that I can place it on the worksheet at some cell that's never going to be used: IE:
Activesheet.range("ZZ1000").formula = "="& functionString
and then reference that cell without worrying whether the program would inadvertently crash; but is there a way to do such a formula from VBA directly?
Basically I'm looking to see whether FirstName.Value and LastName.Value (which are defined elsewhere in the code) together are in the worksheet in column B and column C. As I'm writing this, I realized I need to make sure that they are both in the same row as well and not in different rows.
You could try Application.Evaluate(functionString) but depending on complexity it may be better to use VBA functions instead of WorksheetFunctions.
The Application.Match function will return an error type if the value is not found in the range/array, so we Dim first, last as variant type to allow for this (without raising an error).
Dim first, last
' find the row where FirstName.Value appears in column C
first = Application.Match(FirstName.Value, Columns(3), False))
' find the row where LastName.Value appears in column B
last = Application.Match(LastName.Value, Columns(2), False))
If Not IsError(first) And Not IsError(last) Then
If first = last Then
' match was found in both columns and on same row
' do something else...
End If
End If
I apologize if there is already the same question asked elsewhere with an answer however I have been unable to find it so here I go.
I will also mention that I am a VBA beginner, mostly playing around with codes obtained from other people to get what I want.
I currently have data in Columns A-D, with the information in column C being the important column. Everything else should be ignored.
I have a line of text in cell C1 of sheet1. It is 25 characters long and resembles the following:
4760-000004598700000000000
I have over ~970,000 rows of data and need to pull out the information found within each of these cells into two different cells in another sheet.
I cannot simply use a formula due to the number of records (excel crashes when I try).
If using the mid function for C1, I would enter something like (C1,2,3) and (C1,5,11). (except it would be for each cell in column C)
The leading zeroes between the + or - and the beginning of the first non-zero value are of no consequence but I can fix that part on my own if need be.
Ideally the information would be pulled into an existing sheet that I have prepared, in the A and B columns. (IE:sheet2)
For example, using the text provided above, the sheet would look like:
A|B
760|-0000045987 or -45987
I have looked into array, split and mid codes but I had troubles adapting them to my situation with my limited knowledge of VBA. I am sure there is a way to do this and I would appreciate any help to come up with a solution.
Thank you in advance for your help and please let me know if you need any additional information.
It sounds like what you're after could be achieved by the Text to Columns tool. I'm not sure whether you're trying to include this as a step in an existing macro, or if this is all you want the macro to do, so I'll give you both answers.
If you're just looking to split the text at a specified point, you can use the Text to Columns tool. Highlight the cells you want to modify, then go to the Data tab and select "Text to Columns" from the "Data Tools" group.
In the Text to Columns wizard, select the "Fixed Width" radio button and click Next. On step 2, click in the data preview to add breaks where you want the data to be split - so, in the example you gave above, click between "760" and "-". Click Next again.
On step 3, you can choose the format of each column that will result from the operation. This is useful with the leading zeroes you mentioned - you can set each column to "Text". When you're ready, click Finish, and the data will be split.
You can do the same thing with VBA using a fairly simple bit of code, which can be standalone or integrated into a larger macro.
Sub RunTextToColumns()
Dim rngAll As Range
Set rngAll = Range("A1", "A970000")
rngAll.TextToColumns _
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(3, 2))
With Sheets("Sheet4").Range("A1", "A970000")
.Value = Range("A1", "A970000").Value
.Offset(0, 1).Value = Range("B1", "B970000").Value
End With
End Sub
This takes around a second to run, including the split and copying the data. Of course, the hard-coded references to ranges and worksheets are bad practice, and should be replaced with either variables or constants, but I left it this way for the sake of clarity.
How about this:
Sub GetNumbers()
Dim Cel As Range, Rng As Range, sCode As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Rng = Sheets("Sheet1").Range("C1:C" & Sheets("Sheet1").Range("C1048576").End(xlUp).Row)
For Each Cel In Rng
Sheets("Sheet2").Cells(Cel.Row, 1).Value = Mid(Cel.Value, 2, 3)
sCode = Mid(Cel.Value, 5, 11)
'Internale loop to get rid of the Zeros, reducing one-by-one
Do Until Mid(sCode, 2, 1) <> "0" And Mid(sCode, 2, 1) <> 0
sCode = Left(sCode, 1) & Right(sCode, Len(sCode) - 2)
Loop
Sheets("Sheet2").Cells(Cel.Row, 2).Value = sCode
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
I think there's an array formula thing that would do this, but I prefer the brute force approach. There are two ways to fill in the fields, with a procedure or with a function. I've done both, to illustrate them for you. As well, I've purposely used a number of ways of referencing the cells and of separating the text, to illustrate the various ways of achieving your goal.
Sub SetFields()
Dim rowcounter As Long, lastrow As Long
lastrow = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row 'get the last row in column "C"
For rowcounter = 1 To lastrow 'for each row in the range of values
'put the left part in column "D"
ActiveSheet.Range("D" & rowcounter) = FieldSplitter(ActiveSheet.Cells(rowcounter, 3).Text, True)
'and the right part in the column two over from colum "C"
ActiveSheet.Cells(rowcounter, 3).Offset(0, 2) = FieldSplitter(ActiveSheet.Cells(rowcounter, 3).Text, False)
Next rowcounter
End Sub
Function FieldSplitter(FieldText As String, boolLeft As Boolean) As String
If boolLeft Then
FieldSplitter = Mid(FieldText, 2, 3) 'one way of getting text from a string
Else
FieldSplitter = Left(Right(FieldText, 16), 5) ' another way
End If
'Another useful function is Split, as in myString = Split (fieldtext, "-")(0) This would return "4760"
End Function
I have a list of query words that I am submitting to a database (Column A) to generate a list of coded matches (Columns F-H). Column F is the original search word (so there is an exact match somewhere in Column A), Column G contains the match, and Column H contains the code for the match. What I need to do is take the query word in Column F and find its partner in Column A. Then I need to take the corresponding match and its code and paste it next to the original search term in Column A (in Columns B&C).
My problem here is getting the information pasted in the correct cell since the copy to and paste from locations change every time -- The list of coded matches in Columns F-H does NOT contain all of the terms in Column A.
I've been searching the internet and I can't seem to figure out what exactly I need to change to allow the paste function to work.
I have attached an image of a simplified version of my spreadsheet and a annotated version of the code I have been working with.
Sub FindMatch()
LastRow = Cells(Rows.Count, 6).End(xlUp).Row
For i = 1 To LastRow
FindMe = Cells(i, 6).Value
Set FoundinList = Cells.Find(What:=FindMe, After:=ActiveCell, LookAt:=xlWhole)
If Not FoundinList Is Nothing Then
FoundinList.Select
ActiveCell.Offset(0, 1).Select
'At this point the cell I want the information pasted into is selected. Yay!
'Example: I am trying to find "abnormal digits" (F1) in Column A and paste
'G1:H1 into the appropriate cells in Columns B & C (In this case B15:C15)
'At this point in the code my cursor is on cell B15 - which is where I need it.
Range(Cells(i, 7), Cells(i, 8)).Copy
'This selects the appropriate range (G1:H1 in my example).
ActiveCell.Paste
'This is the problem string. I've tried naming the "ActiveCell" before initiating the copy
'string (ActiveCell.Name = "PasteHere") and then pasting into the named cell
'(Cells("PasteHere").Paste), but that gives me an invalid procedure call or argument on:
'Cells("PasteHere").Paste I've also tried pasting into a range:Range(Cells(PasteHere, 2)
', Cells(PasteHere, 3)).Paste -AND- using the formula that is created when you a record a
'macro (Application.CutCopyMode = False) but both of those give me an application
'/object-defined error.
End If
Next i
End sub
Thank you so much in advance for reading this post and helping me out.
My Spreadsheet
End Product
This vba uses the worksheet function vlookup.
Sub ahhn()
Dim ws As Worksheet
Dim cel As Range
Set ws = ActiveSheet
With ws
For Each cel In .Range(.Range("A1"), .Range("A1").End(xlDown))
cel.Offset(0, 1) = WorksheetFunction.IfError(Application.VLookup(cel, .Range("F:H"), 2, 0), "")
cel.Offset(0, 2) = WorksheetFunction.IfError(Application.VLookup(cel, .Range("F:H"), 3, 0), "")
Next
End With
End Sub
I am trying to create an excel macro which is probably going to end up being quite large, to make things easier I am tackling it a bit at a time. So far I have....
Sub Macro4()
'
' Test Macro
'
'Selects the product_name column by header name
Dim rngAddress As Range
Set rngAddress = Range("A1:Z1").Find("product_name")
If rngAddress Is Nothing Then
MsgBox "The product_name column was not found."
Exit Sub
End If
Range(rngAddress, rngAddress.End(xlDown)).Select
'Inserts new column to the left of the product_name column
Selection.Insert Shift:=xlToRight
'Re-selects the product_name column
Range(rngAddress, rngAddress.End(xlDown)).Select
'Copys the contents of the product_name column
Selection.Copy
Selection.Paste
End Sub
I want it to do the following....
Search the spreadsheet for the header name 'product_name'
Insert a blank column to the left of the 'product_name' column
Copy the contents of the 'product_name' column
Paste them into the newly created blank column
Change the header name in this new column to 'product_name_2'
Currently it works fine up until the pasting into this newly created column, then i get a
'Run-time error '438'; - Object doesn't support this property or method'
Can anyone suggest where i am going wrong?
Your error is:
Range(rngAddress, rngAddress.End(xlDown)).Select
This selects from the top of the column down to just above the first blank cell. The insert shifts this portion of the column right leaving the rest where it is. When you select again you are likely to get a larger range because you have mixed two columns. The copy fails because you are then trying to copy values over the top of values.
If that does not make sense, step through your macro with F8 and see what is happening at each step.
When you understand why your current macro does not work, try this:
Sub Macro5()
Dim rngAddress As Range
Dim ColToBeCopied As Integer
Set rngAddress = Range("A1:Z1").Find("'product_name")
If rngAddress Is Nothing Then
MsgBox "The product_name column was not found."
Exit Sub
End If
ColToBeCopied = rngAddress.Column
Columns(ColToBeCopied).EntireColumn.Insert
Columns(ColToBeCopied + 1).Copy Destination:=Columns(ColToBeCopied)
End Sub
Note:
I did not select anything.
I have left the code operating on the active sheet but it is better to use With Sheets("XXX") ... End With.
Answer to second question
The macro recorder is not good at showing how to address individual cells systematically.
With Sheets("xxxx")
.Cells(RowNum,ColNum).Value = "product_name 1"
End With
The above uses With which I recommend. Notice the dot in front of Cells.
The one below operates on the active sheet.
Cells(RowNum,ColNum).Value = "product_name 1"
RowNum must be a number. ColNum can be a number (say 5) or a letter (say "E").
In your case RowNum is 1 and ColNum is ColToBeCopied and ColToBeCopied + 1.
P.S.
I forgot to mention that to find the botton row of a column use:
RowLast = Range(Rows.Count, ColNum).End(xlUp).Row
That is move up from the bottom not down from the top.
P.S. 2
To specify a range using Cells:
.Range(.Cells(Top,Left),.Cells(Bottom,Right))
The dots must match: all three or none.
I'm not sure where you are trying to copy to,
but when you want to paste you need to make a selection and then
ActiveSheet.Paste
For example:
/your code/
Selection.Copy
Range("O:O").Select
ActiveSheet.Paste
I would avoid copying / pasting altogether, if you only want to transfer values.
For example, instead of:
Range("B1:B100").Copy Destination:=Range("A1")
I would use:
Range("A1:A100").Value = Range("B1:B100").Value
If we were to substitute that into your code, and include some of the comments made by Tony:
Sub Macro4()
Dim colFound As Integer
Dim rowLast As Long
Const rowSearch As Integer = 1
'Find the product_name column
colFound = Rows(rowSearch).Find("product_name").Column
If colFound = 0 Then
MsgBox "The product_name column was not found."
Exit Sub
End If
'Find the last non-empty row
rowLast = Cells(Rows.Count, colFound).End(xlUp).Row
'Inserts new column to the left of the product_name column
Columns(colFound).EntireColumn.Insert
'Transfer the contents of the product_name column to the newly inserted one
Range(Cells(rowSearch, colFound), Cells(rowLast, colFound)).Value = _
Range(Cells(rowSearch, colFound + 1), Cells(rowLast, colFound + 1)).Value
'Rename the new column
Cells(rowSearch, colFound).Value = Cells(rowSearch, colFound).Value & "_2"
End Sub