Excel VBA shorten If statement code for automation - excel

I'm automating an excel form and my code is too long. How do I make my code efficient?
I haven't tried anything yet.
If list = Range("E2").Value Then Result = "321"
If list = Range("E3").Value Then Result = "322"
If list = Range("E4").Value Then Result = "325"
If list = Range("E5").Value Then Result = "404"
I expect the output will be short and easy to understand.

If I understand correctly and list is one of the value in the column "E" and you need the corresponding value from the Column "D":
Dim a As Range
Set a = Range("E1:E100").Find(What:=list, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not a Is Nothing Then
Result = a.Offset(0, -1).Value
End If
You can use this code to get the list from the column E and then use offset -1 to reach the corresponding value from the Column D

Related

Trying to offset a value once a a string is found

So I am using the "find" function in VBA and once this value is found, I am wanting to offset 2 cells to the right. I'm not sure if something is right with my logic, but does anyone mind having a look at my code?
Set StationSearchCell = StationLocationRng.Find(what:="*" & ShortenLocationName & "*", LookIn:=xlValues, lookat:=xlWhole)
'If the StationSearchCell returns a value
If Not StationSearchCell Is Nothing Then
projectinfosheet.Range("B23").Value = StationSearchCell.Offset(0, 2).Value
Else
End If

Lookup value in 2-D List in Excel and find last instance

I am in need of some major assistance. I am trying to create a VBA function that will allow me to find the last five instances of a string in a 2-D set of data and return the name of the column that each instance is in.
I have a data workbook which looks like this:
picture of data worksheet
Essentially, every day every employee has a different placement and we input their names into this sheet. On a separate sheet, pictured below, the name of the employee is entered and their percentages and last 5 placements are shown. I can do simple things in VBA like making functions and the like, however I have no idea how to go about this beast. Any help would be much appreciated.
Picture of Percentages page
data page with info:
link
I think this should do it: I was interested to investigate it as some of the microsoft docs/functionality around FindNext I think might be bugged.
The function takes as a parameter the name of the person and a range of all the logged palcements. It returns an array of 5 columns so you'll need to familiarise yourself with ctrl-shift-enter for array functions
e.g. Formula for b13:f13 is =find_last_5(A13, $A$3:$G$10)
Option Explicit
Function find_last_5(ByVal employee_name As String, ByRef placement_data As Range)
Const number_placements_required = 5
' return array
Dim placements() As Variant
'redim to required size (1 row by 5 columns)
ReDim placements(0, number_placements_required - 1)
Dim i As Long
' initialise return array to #n/a
For i = 0 To number_placements_required - 1
placements(0, i) = CVErr(xlErrNA)
Next i
i = 0
Dim first_found As String
Dim found As Range
With placement_data
'search passed array, backwards looking along rows from last/bottom row cell towards the top left
Set found = .Find(what:=employee_name, _
after:=placement_data.Range("a1"), _
LookIn:=xlValues, _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows)
If Not found Is Nothing Then
first_found = found.Address
Do
placements(0, i) = found.Column
Set found = .Find(what:=employee_name, _
after:=found, _
LookIn:=xlValues, _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows)
i = i + 1
' do until 5 found or nothing found or we wrap back to first address found
Loop While i < number_placements_required And _
Not found Is Nothing _
And found.Address <> first_found
End If
End With
find_last_5 = placements
End Function

Usage of Find function with a variable search request

I'm facing a small mystery with the Find function : if get the "researched string" via the code and put it in a varaible, it don't work (gives "Nothing") but if I replace the variable by the actual search request (between some "" of course), it works fine...
Some code will surely help :
The goal here is to :
get a part code number in one excel file,
then go to another excel file (containing the prices of all the parts),
searching for this part number
and then getting it's price (simple offset) for later usages
I defined MainWrkBk as the main file, where I want to import the data and SecondWkbk as the one where I want to get the part price from
Do While Lin < LastRow
TPICode = Worksheets("C Parts Prices").Range("A" & Lin).Value 'Gets the TPI Code (never know...)
Do While col <= NbCol + 2
PartNumber = Worksheets("C Parts Prices").Range(Split(Cells(1, col).Address, "$")(1) & Lin).Value 'gets the part number stored in the table
PartNumber = CStr(PartNumber) 'it's useless, but for safety...
SecondWkbk.Activate 'Go on the second workbook that has just been opened
Worksheets(PriceListSheet).Range("A1").Select 'this is probably useless
With Worksheets(PriceListSheet).UsedRange
Set SearchResult = .Find(What:=PartNumber, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns)
End With
If SearchResult Is Nothing Then
MainWkbk.Activate
Else
Worksheets(PriceListSheet).UsedRange.Find(What:=PartNumber, LookAt:=xlWhole).Select
If SearchResult = PartNumber Then
PriceEuro = ActiveCell.Offset(0, 2)
PriceDollars = ActiveCell.Offset(0, 5)
MainWkbk.Activate
Worksheets("C Parts Prices").Range(Split(Cells(1, col).Address, "$")(1) & Lin + 2).Value = PriceEuro
ElseIf SearchResult = "" Then
MainWkbk.Activate
End If
End If
'Worksheets(TheYear).Select
'Worksheets(TheYear).Range(Split(Cells(1, col).Address, "$")(1) & Lin).Value = PartNumber
col = col + 1
Loop
col = PosStartColumnNb
Lin = Lin + 3
Loop
So, on the line :
With Worksheets(PriceListSheet).UsedRange
Set SearchResult = .Find(What:=PartNumber, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns).Address
End With
1) If I keep the variable PartNumber, whatever is inside, it give back a "nothing", meaning it don't find the data...
2) On the other hand, if in the code I replace PartNumber by its actual number, something like "BR58JE3SO" it is found immediately...
3)If I replace the line
PartNumber = Worksheets("C Parts Prices").Range(Split(Cells(1, col).Address, "$")(1) & Lin).Value
by a simple PartNumber = "BR58JE3SO" , it works fine...
I, of course, tried it that way too :
Set SearchResult = Worksheets(PriceListSheet).UsedRange.Find(What:=PartNumber, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns)
No difference :(
May someone explain me what's happening, please?
Edit : a small image to show that :
Well, apparently, the only solution would be to create a loop passing through all the cells of the second workbook...
Thank's Find function :'(

Perform a FIND, within VBA, from the bottom of a range up

Is it possible for Find to start from the bottom of a range and work up?
I would like my code to first find a record number located on a master list. Once it finds the record number I want it to assign that deals name, an offset of the record number, to a variable and then search up the master list for the first deal with that name.
I have code that finds the record number, assigns the deal name to a variable and then loops up each cell until it finds a match. Although this way works, the loop processing time is significantly slower than the find processing time and I am searching for the fastest solution.
If reverse find is not a possibility, would a vlookup work? Possibly by, creating a range beginning one row above the record number to the top and have vlookup find the last occurrence?
PendingBRow = ThisWorkbook.Sheets("PendingLog").Range("A65000").End(xlUp).Row
MasterBRow = ThisWorkbook.Sheets("MasterLog").Range("A65000").End(xlUp).Row
For D = 2 To PendingBRow
With ThisWorkbook.Sheets("PendingLog").Range("A" & D)
PendingRecNum = .Value
PendingDealName = .offset(0, 3).Value
PDLenght = Len(PendingDealName) - 4
PendingDealName = Left(PendingDealName, PDLenght)
PendingDealName = UCase(PendingDealName)
PendingDealName = Trim(PendingDealName)
End With
With ThisWorkbook.Sheets("MasterLog").Range("B2:B" & MasterBRow)
Set c = .Find(PendingRecNum, LookIn:=xlValues)
If Not c Is Nothing Then
firstRow = c.Row - 1
O = 1
Do Until firstRow = O
LastWorkedBy = ThisWorkbook.Sheets("MasterLog").Range("E" & firstRow).offset(0, 20)
MasterRecNum = ThisWorkbook.Sheets("MasterLog").Range("E" & firstRow).offset(0, -3).Value
dealName = ThisWorkbook.Sheets("MasterLog").Range("E" & firstRow).Value
dealName = Left(dealName, 10)
dealName = UCase(dealName)
dealName = Trim(dealName)
If PendingDealName = dealName Then
MasterLastWorkedBy = LastWorkedBy
ThisWorkbook.Sheets("PendingLog").Range("A" & D).offset(0, 19).Value = MasterLastWorkedBy
firstRow = O
Else
firstRow = firstRow - 1
End If
Loop
End If
End With
Next D
This will FIND() from the bottom:
Sub FindFromTheBottom()
Set a = Range("A:A").Find("Test", after:=Cells(1, 1), searchdirection:=xlPrevious)
MsgBox a.Address(0, 0)
End Sub
the after cell specified has to be within the search range; if you remove after:=, then active cell is taken as the after cell.

Dynamically read in Column

I have a problem. I spent hours designing a form which works just great with all your feedback. Today, everything went wrong. The reason for this is simple. A few new columns got added and, obviously, the data my form is reading in is now wrong.
Thus I was thinking of trying the following...
Rather than using the column number as below
TK = Cells(ActiveCell.Row, "S").Value 'everything in the form refers to the active row
I could possibly use the column headings in Row 1.
Is that possible ? This way the spreadsheet can have columns added up to as many as a user would like and the form would dynamically scan for the right heading and get the column number that way.
My thought is, on opening the form, read in all the headings, pick out the ones I need and assign them to a variable. Then I use my normal code and substitute the variable into the column section.
It sounds easy, but I have no idea how to do this.
Use the versatile Find to give you a quick method of detecting where your header is - or if it is missing
Find details here
In the code below I have specified that the search must return
an exact match (xlWhole)
a case sensitive match (False)
The match can be a partial match (xlPart) if you were looking to match say Game out of Game X
code
Const strFind = "Game"
Sub GetEm()
Dim rng1 As Range
Set rng1 = ActiveSheet.Rows(1).Find(strFind, , xlValues, xlWhole, , , False)
If Not rng1 Is Nothing Then
MsgBox "Your column is " & rng1.Column
Else
MsgBox strFind & " not found", vbCritical
End If
End Sub
Why use a loop? There's no need to.
Dim col as variant
Col = application.match("my header", rows(1), 0)
If iserror(col) then
'not found
Else
TK = cells(activecell.row, col)
End if
For this purpose I usually use a function which runs through the headers (in the first row of a sheet) and returns the number of the column which contains the value I have searched for.
Public Function FindColumn(HeaderName As String, Sht As String) As Long
Dim ColFound As Boolean
Dim StartingPoint As Range
ColFound = False
Set StartingPoint = Sheets(Sht).Range("A1")
Do While StartingPoint.Value <> ""
If UCase(Trim(StartingPoint.Value)) = UCase(Trim(HeaderName)) Then
FindColumn = StartingPoint.Column
ColFound = True
Exit Do
Else
Set StartingPoint = StartingPoint.Offset(0, 1)
End If
Loop
If Not ColFound Then FindColumn = 0
End Function
Example:
If the first row of your sheet named "Timeline" contains headers like e.g. "Date" (A1), "Time" (B1), "Value" (C1) then calling FindColumn("Time", "Timeline") returns 2, since "Time" is the second column in sheet "Timeline"
Hope this may help you a little.
Your thought is a good one. Reading in column headers to calculate addresses is one way to avoid hard coding - e.g.
Sub Test()
Dim R As Range
Set R = ActiveSheet.[A1]
Debug.Print ColNo(R, "Col1Hdr")
End Sub
Function ColNo(HdrRange As Range, ColName As String) As Integer
' 1st column with empty header is returned if string not found
ColNo = 1
Do While HdrRange(1, ColNo) <> ""
If HdrRange(1, ColNo) = ColName Then Exit Do
ColNo = ColNo + 1
Loop
End Function
Another way I frequently use - and I must admit I prefer it over the above, is to define Enum's for all my tables in a seperate "definition" module, e.g.
Public Enum T_VPN ' sheet VPN
NofHRows = 3 ' number of header rows
NofCols = 35 ' number of columns
MaxData = 203 ' last row validated
GroupNo = 1
CtyCode = 2
Country = 3
MRegion = 4
PRegion = 5
City = 6
SiteType = 7
' ....
End Enum
and use it like
Sub Test1()
Debug.Print ActiveSheet(T_VPN.NofHRows, T_VPN.Country)
End Sub
As you can see, the usage is simpler. Allthough this is again "some kind" of hardcoding, having all definition in one place reduces maintenance significantly.

Resources