Excel VBA Vlookup issue - excel

I'm a complete beginner to Excel VBA.
The following is code I've written that should iterate through a column in a sheet, filling values by referring to the column value to it's left and referring to another sheet in the same workbook to find what the correct corresponding value should be.
I've used a While loop so i can apply this VLOOKUP macro to each cell in the column ( only the lookup value, changes, which should be a variable denoting the column to the left) :
Dim result As String
Dim sheet As Worksheet
Dim rownum As Integer
Dim iterator As Integer
Dim lookup_value As String
Dim vlookupString1 As String
Set sheet = ActiveWorkbook.Sheets("datasheet")
rownum = sheet.Range("A1").End(xlDown).Row
Set iterator = 3
While iterator < rownum
lookup = "M" & iterator
vlookup1String = "=VLOOKUP(" & lookup & ",'GICS Sub-industry codes'!$A$2:$B$155,2,FALSE)"
With ActiveSheet.Cells
Range("N" & iterator).Select
Selection.Value = vlookup1String
End With
iterator = iterator + 1
End While
I'm getting an error # end while saying "expected if or select or sub..."
1) Have i made a syntax error?
2) Is my approach correct. I have observed this string approach to designing VLOOKUPS in vba only in one other place. It seemed best suited.

Fixing your code
You should use Wend not End While for your loop.
Cleaner Alternative
But you can fill an entire range in a single shot as below
It is better to "loop up" a range from the bottom using End(xlup) than to look down with End(xlDown) (which relies on no spaces)
You almost never need to use Select in VBA
Further explanation
rng1 sets a working range from the last used cell in column A in sheet datasheet to A3
rng1.Offset(0, Range("N1").Column - 1) says offset rng1 (which is column A) by 13 columns to use column N (ie OFFSET A by 14-1) for the formula insertion
I used the macro recorder to get the code you needed in column N for this part "=VLOOKUP(RC[-1],'GICS Sub-industry codes'!R2C1:R155C2,2,FALSE)".
IN R1C1 speak, RC[-1] means refer to the cell in the same row, but one column to the left. So in N3, the formula will start as =VLOOKUP(M4..), So in N30, the formula will start as `=VLOOKUP(M30..) etc
Suggested code
Sub QuickFill()
Dim ws As Worksheet
Dim rng1 As Range
Set ws = Sheets("datasheet")
Set rng1 = ws.Range(ws.[a3], ws.Cells(Rows.Count, "A").End(xlUp))
rng1.Offset(0, Range("N1").Column - 1).FormulaR1C1 = "=VLOOKUP(RC[-1],'GICS Sub-industry codes'!R2C1:R155C2,2,FALSE)"
End Sub

Related

Excel VBA: using chars + integers in a switch case

this is a follow up to my post at: Excel VBA: Switch Case to read values from a column
I currently have one working switch statement that looks for a case e.g (493) from Column I, and if it finds 493 it returns "Robotics" in column G.
Now I need to create a second switch statement that looks for a case e.g (EPA0012) from column AN, and if it finds EPA0012 it will display "Accounting" in column AO. The issue I am encountering is that when I run the same code that I used for the first switch statement, instead of it populating the adjacent column with "Accounting", it instead populates every single cell in the column except for the column adjacent to EPA0012 (where it should be populating).
The issue is because of "EPA" as when I removed this and just use 0012 it worked perfectly so I am assuming I need to adjust a variable or something.
The code is as follows:
Public Sub Switch_Statement_EPA()
Dim wsSort As Worksheet
Set wsSort = Workbooks("Test.xlsm").Worksheets(2)
With wsSort
Dim lastRow As Long
lastRow = .Range("AN" & .Rows.Count).End(xlUp).Row
Dim rng As Range
Set rng = .Range("AN2:AN" & lastRow)
Dim cell As Range
For Each cell In rng '<--- the loop
Select Case cell.Value
Case EPA0012
cell.Offset(, 1).Value = "Accounting"
End Select
Next
End With
MsgBox ("Done")
End Sub

Is there a function in macro or VBA to extract data from cell with conditions

I am trying to find a way, if there is such, to compare two columns where in column A there are numbers, and in column B there is data. In Column B the data is something like "1 - the link to publication is missing; 2 - no signature given; 5 - no references;".
If the first character from Column B matches the number in Column A, then extract from Column A starting from the matching number to ";".
I am pretty sure this can be done on Python, but have no idea about VBA or in macro in Excel, as I've been working a lot with Excel lately.
Thank you for your time and help!
Cheers.
You're asking if VBA has Loops and can evaluate boolean expressions? Yes, it has those. For , ForEach, Do, While, If
You would be looking for something like:
Sub Example()
Dim MyValuesFromSheet1 As Collection
Set MyValuesFromSheet1 = GrabValues(Sheet1)
End Sub
Function GrabValues(WS As Worksheet) As Collection
Dim SavedValues As New Collection
Dim LastRow As Long
LastRow = WS.Columns(1).Cells(WS.Rows.Count).End(xlUp).Row
Dim SearchRange As Range
Set SearchRange = WS.Range("A1:A" & LastRow)
Dim Cell As Range
For Each Cell In SearchRange
If Cell.Value <> "" And Cell.Value = Left(Cell.Offset(, 1), 1) Then SavedValues.Add "that extracted region you described"
Next
Set GrabValues = SavedValues
End Function

Assigning cell value based to vlookup result - VBA

After failing to figure out how to do that for a while, I'll try my luck here:
I'm essentially trying to compare two situations using VBA.
A similar (and a lot simpler) example:
F2, for example, calculate 152+D2, while F3 calculates 185+D3.
I wish to run a macro that would check the effect of one person getting a different amount of points. For example, if A2 = Max the macro should assign the value of A3 (18) to D3. If A2 = Lewis, 18 would become the new value of D2.
Tried using vlookup and match+index in order to find the cell that I want to change. When using vlookup, the code looked similar to this:
First I copied F2:F4 to I2:I4, so the results would be comparable. Then tried to replace the value of D2:D4 according to A2&A3:
name = Range("A2").value
newvalue = Range("A3").value
Find = Application.VLookup(name, Range("C2:D4"), 2, False)
Find.value = newvalue
Perhaps I should be looking for the cell itself, and not the value, and then it would work (maybe using offset, or offset+match? couldn't make it work)?
Would appreciate any help!
Not really sure what the intention is but this seems like a fun challenge.
So logic is this. We look for the name in column C. If we get a match we will get a row back as an answer, then we replace the value from "A3" and add it to the row we got but to the column D.
Maybe something like this :D?
Option Explicit
Sub something_test()
Dim lookup_val As String
Dim lrow As Long
Dim lookup_rng As Range
Dim match_row As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet1") 'Name the worksheet
lrow = ws.Cells(Rows.Count, "C").End(xlUp).Row 'Find last row in Sheet1
lookup_val = ws.Cells(2, "A").Value 'Set the lookup value
Set lookup_rng = ws.Range("C2:C" & lrow) 'set the lookup range
match_row = Application.Match(lookup_val, lookup_rng, 0) + 1 'Find the name in column C. Add +1 since the range starts at row 2. We will get the row number back
ws.Cells(match_row, "D").Value = ws.Cells(3, "A").Value 'Take the value from "A3" and replace the existing value at the row we found, but for column D
End Sub

vba excel Find string, move to an offset location, copy dynamic range to another sheet

What I have been doing previously is manually selecting and then copy/paste raw data from a report into a sheet titled "ImportDump". From here I use VBA to select and copy the 11 ranges I am interested in across to specific locations in Sheet1 and Sheet2. I would explicitly state the ranges that the data occupy in the ImportDump sheet and copy them across. This worked but is no longer simple to do.
Instead, I plan to search for each table heading in Column A in the ImportDump sheet using the Find method, and then use the result of Find, plus an offset, as the starting position of a dynamic range. So for example, the string "Capital Premier" is found in A30, but the range I need starts in B33. I then need all rows down to the next blank cell in Column B, and all columns across to the next blank column (data always finishes in Column J). And then repeat for all further 11 heading strings. The headings will all appear in Column A, all the tables will have the same offset from the search string result (3,1), and the same number of columns (9), but not necessarily the same number of rows.
I think I know how to do the search IDump.Range("A1:A200").Find(What:="Capital Premier", LookIn:=xlValues, LookAt:=xlPart), and I'm pretty sure I can use .End(xldown) to select down to the next blank row, but I'm not sure how to combine all that with an offset to express the starting location of my dynamic range. Could someone please help me to solve this?
Edit: I've found my ideal solution (unless someone comes up with something even better)
This code combines a look at a table on one sheet ("Instructions") for a user-defined string, a search for the string in a separate sheet ("ImportDump" - a raw data dump), once the string is found it jumps to an offset cell location (3,1), finds the last row and last column before the next blank, selects the range outlined by the offset location, lastrow and lastcol, copies the range to a location (Sheet, then Cell) defined in the initial search table that corresponds to the search string. It then loops through all the rest of the user-defined strings until the last row of the table in the "Instructions" sheet, finding the ranges and pasting them into the corresponding predetermined locations. Thanks for everyone's input!
Sub ImportLeagueTables()
Dim r As Range
Dim i As Integer
Dim IDump As Worksheet
Dim Instruct As Worksheet
Dim what1, where1, where2 As String
Dim TeamRng, TableRng, f, g As Range
Dim LastRowTeam As Long, Lastrow, Lastcol As Long
Set Instruct = Sheets("Instructions")
Set IDump = Sheets("ImportDump")
LastRowTeam = Instruct.Range("M4").End(xlDown).Row
Set TeamRng = Instruct.Range("M4:O" & LastRowTeam)
i = 1
For Each r In TeamRng.Rows 'rows to loop through
what1 = TeamRng.Range("A" & i) 'the string to find
where1 = TeamRng.Range("B" & i)
where2 = TeamRng.Range("C" & i)
Set f = IDump.Columns(1).Find(what1, LookIn:=xlValues, LookAt:=xlPart)
Set g = f.Offset(3, 1)
Lastrow = g.Range("A1").End(xlDown).Row
Lastcol = g.SpecialCells(xlCellTypeLastCell).Column
Set TableRng = IDump.Range(g, IDump.Cells(Lastrow, Lastcol))
TableRng.Copy
Sheets(where1).Range(where2).PasteSpecial xlValues
i = i + 1
Next r
End Sub
Original, less robust solution: Ok, I've come up with a workable solution by explicitly defining the range with reference to the first cell i.e. Set g = f.Offset(3, 1) and Set CapPremRng = g.Range("A1:I10"), although that's not as elegant as I would like. Would prefer to use g to select all cells down and across until the next blank row/column.
Full code:
Sub DoMyJob()
Dim IDump As Worksheet
Dim f As Range
Dim g As Range
Dim CapPremRng As Range
Set IDump = Sheets("ImportDump")
Set f = IDump.Range("A1:A200").Find(What:="Capital Premier", LookIn:=xlValues, LookAt:=xlPart)
Set g = f.Offset(3, 1)
Set CapPremRng = g.Range("A1:I10")
CapPremRng.Copy
Sheets("Sheet3").Range("A1" & LastRow).PasteSpecial xlValues
End Sub

Last Row in Excel VBA Evaluate

I am using the below code:
Sub Evaluation_Formula()
Dim i As Long
With Worksheets("Sheet1")
i = .Evaluate("MIN(IF((LEFT($B$1:$B$89,5)*1)=C1,$B$1:$B$89,""""))")
.Range("F3").Value2 = i
End With
End Sub
However, the formula is limited to B89, how can I use Last Row in Column B in the formula ?
For all intents and purposes you are really only concerned with the last number in column B, not specifically the last row. To do that in a worksheet formula you would use something like this array formula.
=MIN(IF(--LEFT(B1:INDEX(B:B, MATCH(1E+99,B:B )),5)=C1, B1:INDEX(B:B, MATCH(1E+99,B:B))))
That can translate into your VBA Evaluate method like the following.
Sub Evaluation_Formula()
Dim i As Long
With Worksheets("Sheet1")
i = .Evaluate("MIN(IF(--LEFT(B1:INDEX(B:B, MATCH(1E+99,B:B )),5)=C1, B1:INDEX(B:B, MATCH(1E+99,B:B))))")
.Range("F3").Value2 = i
End With
End Sub
The double unary (aka double-minus or --) does the same job as multiplying the text result from the LEFT function by 1. There is no need to pass a zero-length string (e.g. "") in as the FALSE is sufficient for non-matches in the IF function. Since you are evaluating text into a formula, there is no need for the $ absolute markers.
Keep the . in .Evaluate or add the worksheet name to the cell references in the formula. Without it you run the risk of evaluating another worksheet's B1:B89 and C1 cells if Sheet1 does not hold the workbook's ActiveSheet property.
I guess this will post proper code:
Sub Evaluation_Formula_w_LR()
Dim i As Long
Dim LR As Long
With Worksheets("Sheet1")
LR = .Cells(.Rows.Count, 2).End(xlUp).Row
i = Evaluate("MIN(IF((LEFT($B$1:$B$" & LR & ",5)*1)=C1,$B$1:$B$" & LR & ",""""))")
.Range("F10").Value2 = i
End With
End Sub

Resources