Automated tool for VLOOK UP - vba

I need to perform many VLookup in a set of excel files, and for that I built a tool that can make automated VLookup from a file to another but I need to be make it scalable and adaptable.
For that, I want to input in some cells of the tool (which is an Excel file) the parameters for the VLookup:
Position of Key Column
Position of "Returned Value" Column
Number of Columns in the range
Do you know how to change my tool in order for it to include these entry parameters ?
a sample of the code here:
For myrow = 3 To lastrow
Range("b" & myrow).FormulaR1C1 = _
"=VLOOKUP(RC[-1], Input!C[-1]:C[2],2,FALSE)"
Next myrow

I'm not well versed in R1C1 notation, but if you were using regular .Formula notation:
The following code assumes that A1 = Key column, A2 = Returned value column, A3 = Number of columns in the range (which is really just your return column).
lastrow = 10 just for the example
Also note - you must be missing a field... since you should have 4 variables - key column for first parameter, 2 column letters for second parameter, and the number of columns for 3rd parameter.
Sub Test()
lastrow = 10
For myrow = 3 To lastrow
'Range("B" & myrow).Formula = "=VLOOKUP(" & Range("A1").Value & myrow & ",Input!$" & Range("A1").Value & ":$" & Range("A2").Value & "," & Range("A3").Value & ",FALSE)"
Debug.Print "=VLOOKUP(" & Range("A1").Value & myrow & ",Input!$" & Range("A1").Value & ":$" & Range("A2").Value & "," & Range("A3").Value & ",FALSE)"
Next myrow
End Sub
Values on ActiveSheet:
Immediate window returns:

Related

Correcting formula in vba excel

I want to create a macro that check all the cells of a column and if the first two characters of a cell is "BB" then i want the macro to extract three characters from the cell and paste it to the next column but a the corresponding row.
But my formula after the if clause is not working.
this is what i have done since:
Sub test()
Dim lmid As String
Dim srange, SelData, ExtBbFor As String
Dim lastrow As Long
Dim i, icount As Integer
lastrow = ActiveSheet.Range("B30000").End(xlUp).Row
srange = "G1:G" & lastrow
SelData = "A1:G" & lastrow
Range(srange).Formula = "=mid(E1,1,3)"
For i = 1 To lastrow
If InStr(1, LCase(Range("E" & i)), "bb") <> 0 Then
Range("G" & i).Formula = "=mid("E & i", 4, 3)"
End If
Next i
End Sub
thanks in advance
Try with below. It will work
Range("G" & i).Value = Mid(Range("E" & i), 4, 3)
If the cell is not limited to 7 then you need as below
Range("G" & i).Value = "=Mid(E" & i & ", 3, " & Len(E & "& i & ") & ")"
It will extract from the 3rd character up to the last character in a cell.
Your syntax is wrong where you're trying to concatenate strings, I think you mean to use:
Range("G" & i).Formula = "=MID(E" & i & ",4,3)"
Based on your code I think this will do the exact same thing without having to loop or declare any variables:
Sub test()
With Range("G1:G" & Cells(Rows.Count, 2).End(xlUp).Row)
.FormulaR1C1 = "=IF(UPPER(LEFT(RC[-2],2))=""BB"",MID(RC[-2],4,3),"""")"
.Value = .Value
End With
End Sub

Filling cells with loop in VBA Excel [duplicate]

This question already has an answer here:
Using VBA to place multiple formulas in one cell
(1 answer)
Closed 6 years ago.
I'm trying to fill cells with a for loop like this:
For i = 1 To Target
Range("C" & i & ":C" & i ).Formula = "='Sheet1'!A" & i & "/" & "'Sheet2'!B" & i"
Next i
And I want to see that in the formula bar:
='Sheet1'!A1 & "/" & 'Sheet2'!B1
='Sheet1'!A2 & "/" & 'Sheet2'!B2
...
Unfortunately it's not working. If I try only the first part like that:
For i = 1 To Target
Range("C" & i & ":C" & i ).Formula = "='Sheet1'!A" & i
Next i
This code results this fine, but this is not enough for me:
='Sheet1'!A1
='Sheet1'!B1
...
What is wrong with my frist code?
You could try
Range("C" & i & ":C" & i).FormulaR1C1 = "=Sheet1!RC1 & ""/"" & Sheet2!RC2"
If you are having trouble with double quotes in a concatenated string, I sugest you remove as many as you can. Single characters can be referred to by their ASCII code number with the Chr function. The / character is 47.
Dim i As Long, target As Long
With ActiveSheet
target = .Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To target
.Range("C" & i).Formula = "='Sheet1'!A" & i & Chr(47) & "'Sheet2'!B" & i
Next i
End With
You do not have to increment through a range is the formula is constructed properly. Either an xlA1 or xlR1C1 reference style can be used (see xlReferenceStyle enumeration).
Dim i As Long, target As Long
With ActiveSheet
target = .Cells(Rows.Count, "A").End(xlUp).Row
'xlA1 style
.Range("C1:C" & target).Formula = "='Sheet1'!A1/'Sheet2'!B1"
'xlR1C1 Style
.Range("C1:C" & target).FormulaR1C1 = "='Sheet1'!RC1/'Sheet2'!RC2"
End With
Note that an xlR1C1 style requires the Range.FormulaR1C1 instead of the Range.Formula.

Correct formula giving "Run-time error '1004': Application-defined or object-defined" error when running sub

I want to paste formula's in column B with a delay in between. The formula should only paste the formula if the cell left to it (in case of B1 this is A1) is not empty, like this:
I have the following VBA that pastes the formula with a delay of 1 sec.
Option Explicit
Sub RetrieveDataDelay()
'paste formulas into cells, then calculate, then delay rinse repeat
'=========================
'Declare Variables
'=========================
Dim i As Long 'used to loop
Dim rowCount As Long
Dim LastRow As Long 'used to find the last row
'=========================
'Setup for Speed
'=========================
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'=========================
'Define Variables
'=========================
LastRow = Worksheets(ActiveSheet.Name).Cells(Rows.Count, 1).End(xlUp).Row 'This will find the last used row in column A, change the number 1 to whatever column number you want
rowCount = 1 ' set to how many rows you want to do at a time
'=========================
'Do Work
'=========================
For i = 1 To LastRow Step rowCount
Range("B" & i, "B" & WorksheetFunction.Min(i + rowCount - 1, LastRow)).Formula = "'=IF(ISBLANK(A" & i & ");" & """" & """" & ";Dump(Volumes(A" & i & ";2528;1010;TRUE;" & "Volume" & ";TRUE)))" 'set the formula to whatever it needs to be
Calculate
Application.Wait (Now + TimeValue("00:00:01")) 'this delays 1 second
Next i
'=========================
'Setup for Speed - Reverse
'=========================
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
The error occurs at this part
Range("B" & i, "B" & WorksheetFunction.Min(i + rowCount - 1, LastRow)).Formula = "=IF(ISBLANK(A" & i & ");" & """" & """" & ";Dump(Volumes(A" & i & ";2528;1010;TRUE;" & "Volume" & ";TRUE)))"
The errors has something to due with the formula, which it does not accept. This is a custom formula used with an excel extension. I know that the formula works, as I put a single quotation mark in front as such:
Range("B" & i, "B" & WorksheetFunction.Min(i + rowCount - 1, LastRow)).Formula = "'=IF(ISBLANK(A" & i & ");" & """" & """" & ";Dump(Volumes(A" & i & ";2528;1010;TRUE;" & "Volume" & ";TRUE)))"
so that it pastes the formally literally. If I then remove the quotation mark from the formula the formula works. So the questions remains why it doesn't accept this specific formula in the VBA.
Using Excel 2013.
Range.Formula needs the formula notation always in en_us format independent of the current locale settings. That means functions in English language and also comma as delimiter between formula parameters and not semicolon.
So
.Formula = "=IF(ISBLANK(A" & i & ")," & """" & """" & ",Dump(Volumes(A" & i & ",2528,1010,TRUE," & "Volume" & ",TRUE)))"
After setting Range.Formula, the locale settings will be nevertheless active in the sheet. So in the sheet the formula will be delimited with semicolons if so set.
Btw.: The complicated string notation for double quotes is not neccessary.
.Formula = "=IF(ISBLANK(A" & i & "),"""",Dump(Volumes(A" & i & ",2528,1010,TRUE," & "Volume" & ",TRUE)))"

Overcoming the 255 char. limit for formulaArray in Excel VBA [duplicate]

This question already has an answer here:
How to automatically input an array formula as string with more than 255 characters in length into an excel cell using VBA?
(1 answer)
Closed 2 years ago.
I need an array to be inserted into a specific cell and I keep running into the 1004 error. Here is the code:
Range("o37").FormulaArray = "=CONCATENATE(SUM(IF(('2016 Summary'!$T$4:$T$39<=" & mon & ")*" & _
"('2016 Summary'!$D$4:$D$39>0)*('2016 Summary'!$T$4:$T$39+'2016 Summary'!$D$4:$D$39>" & mon & ")*" & _
"('2016 Summary'!$S$4:$S$39=TRUE),(1),IF(('2016 Summary'!$T$4:$T$39<=" & mon & ")*('2016 Summary'!$S$4:$S$39=TRUE)*" & _
"('2016 Summary'!$D$4:$D$39=0),(1),0)))&"" - Employees"")"
That array is supposed to be inserted into O37 with the "mon" variable based on the activecell column. The formula works when I manually put it in the sheet. I have tried splitting it with .replace and I get the same error. What can I do to make this work with formulaArray?
Depending upon how long the value in the mon variable is, it seems that your array formula is only marginally over the limit at ~290-310 characters and a large portion of that is comprised of the external worksheet name (e.g. '2016 Summary'). Changing the worksheet name temporarily to a single character is sufficient to bring the formula down to the ~190-210 character range; more than adequate to stuff the formula into the cell's Range.FormulaArray property.
Dim strWS As String, chrWS As String
strWS = "2016 Summary"
chrWS = Chr(167) '<~~ any unque, legal, single character that can be temporarily used as a worksheet name
With Worksheets(strWS)
.Name = Chr(167)
End With
With Worksheets("worksheet_with_array_formula")
.Range("o37").FormulaArray = "=CONCATENATE(SUM(IF((" & chrWS & "!$T$4:$T$39<=" & mon & ")*" & _
"(" & chrWS & "!$D$4:$D$39>0)*(" & chrWS & "!$T$4:$T$39+" & chrWS & "!$D$4:$D$39>" & mon & ")*" & _
"(" & chrWS & "!$S$4:$S$39=TRUE),(1),IF((" & chrWS & "!$T$4:$T$39<=" & mon & ")*(" & chrWS & "!$S$4:$S$39=TRUE)*" & _
"(" & chrWS & "!$D$4:$D$39=0),(1),0)))&"" - Employees"")"
End With
With Worksheets(chrWS)
.Name = strWS
End With
Excel will change the worksheet name within the formula, adding wrapping ticks (e.g. '2016 Summary'!$T$4:$T$39) to compensate for the space in the new (old) worksheet name.
If you provided more detail on the value of mon and some sample data from the '2016 Summary' worksheet, it also possible that the formula could be improved. At first glance, it looks like an array formula may not be absolutely necessary at all.
Sub SetTooLongArrayFormula(ByVal rn As Range, ByVal sFormula As String)
Dim sFormat As String
sFormat = rn.Cells(1, 1).NumberFormat
rn.FormulaArray = ""
rn.Cells(1, 1).NumberFormat = "#"
rn.Value = sFormula
rn.Cells(1, 1).NumberFormat = sFormat
rn.Select
DoEvents
SendKeys "{F2}", True
DoEvents
SendKeys "+^{ENTER}", True
End Sub
Sub Test()
'Do not run this macro from VBE Editor
'Run this macro from the Macros ribbon on the Developer tab with the Excel worksheet in front.
Dim sFormula As String
sFormula = "=""1"""
For i = 1 To 250
sFormula = sFormula & "&""1"""
Next
SetTooLongArrayFormula Range("A1:A2"), sFormula
End Sub

VBA search for corresponding line and compare values

I am new to VBA programming, and I am looking for a way to search a range of about 2,000 to 3,000 rows to compare quantities where ID numbers match, and generate a message box displaying the ID number if there are any matching ID numbers where quantities do not match. There are 2 matching ID numbers in the data.
I have found and adapted this code
`Dim rng1 As Range, rng2 As Range, rngName As Range, i As Integer, j As Integer
For i = 1 To Sheets("Sheet1 (2)").Range("q" & Rows.Count).End(xlUp).Row
Set rng1 = Sheets("Sheet1 (2)").Range("q" & i)
For j = 1 To Sheets("Sheet1 (2)").Range("q" & Rows.Count).End(xlUp).Row
Set rng2 = Sheets("Sheet1 (2)").Range("q" & j)
Set rngName = Sheets("Sheet1 (2)").Range("q" & j)
If rng1.Value = rng2.Value Then
If rng1.Offset(0, 2).Value <> rng2.Offset(0, 2).Value Then
MsgBox ("Not equal " & rng1 & " Net " & rng1.Offset(0, 2) - rng2.Offset(0, 2))
Exit For
End If
End If
Set rng2 = Nothing
Next j
Set rng1 = Nothing
Next i`
Honestly, this is beyond my current skill level in VBA, and I can't think of any way to use the Macro recorder to help. I want to know if there is any way to optimize this code to run faster, and also if there is a way to adapt it to write out all ID numbers with the amount of variance, instead of displaying the message box for each ID number individually.
Thanks!
If the data is sorted (assumes ID in column Q, quantity in Column R):
Dim ErrorList as String
With Sheets("Sheet1 (2)")
For i = 1 To .Range("q" & Rows.Count).End(xlUp).Row step 2
if .range("R" & i).value <> .range("R" & i+1) then
ErrorList = ErrorList & "ID: " & .range("Q" & I) & " Net: " & _
.range("R" & i).value - .range("R" & i+1).value & vbcrlf
end if
next
end with
'do something like MsgBox with ErrorList
If the data is NOT sorted (same column assumptions):
Dim ErrorList as String
With Sheets("Sheet1 (2)")
For i = 1 To .Range("q" & Rows.Count).End(xlUp).Row
'assume .range("q"
Set Rng = .Range("q:q").Find(what:=.range("q" & i), LookIn:=xlValues, _
lookat:=xlPart, MatchCase:=False)
If .range("Q" & I).value <> rng.cells(1,1).value then
ErrorList = ErrorList & "ID: " & .range("Q" & I) & " Net: " & _
.range("R" & i).value - .range("R" & i+1).value & vbcrlf
end if
next
end with
'do something like MsgBox with ErrorList
The .Find is MUCH quicker than an inner loop through all the rows of data again (someone a week or so ago tested and found something along the lines of 1000x times faster than a loop). Unfortunately, this method will leave you with duplicate IDs in your mismatch list, since it will run through the whole list, finding each of the pairs and discovering that they both don't match:
ID Value
ABC 1
BCD 6
ABC 2
It will loop to ABC/1, find ABC/2, then later in the loop find ABC/2 and discover that it doesn't match ABC/1, and report on both. The sorted data in the first option will work better if you can get your data sorted.
NOTE: No code was tested in the writing of this answer. There may be typos to resolve
You can do this with a formula if there can be at most only two matches: eg if ID is in ColA and Amount in ColB then in ColC enter
=IFERROR(VLOOKUP(A2,A3:B$9,2,FALSE)-B2,0)
and fill down. Result will be zero if no mismatch (or no matching Id), otherwise will be the difference between the two amounts.