Using VBA - Insert VLOOKUP depending on certain values - vba

I am trying to retrieve data from another file using the VLOOKUP function however this is only to happen depending on if any of the 3 items of data appear in column 8(H)
OLY
OLY - QUO
OLY - PRO
I have the following and know this is not correct
Sub BlockAllocationsVlookupAll()
Dim x As Long
For x = 1 To 65536
If InStr(1, Sheet1.Range("$H$" & x), "OLY") > 0 Then
Sheet1.Range("$I$" & x) = Sheet1.Range("$I$" & x) & "sometext"
End If
Next
End Sub
I know the above doesn't do exactly what I need can anyone help as to what needs to be edited to include the Vlookup below
=VLOOKUP(A21,'[001 - Allocations - Blocks.xls]CurrentDayAll'!$1:$65536,9,FALSE)
The other issue is that the cell the VLOOKUP points to first will also change due to the varying length of the report
Thank you for any help given

UPD:
As follows up from comments,
column H is in Allocations.xls workbook
there are a set of criterias
formula should be placed in cell only if corresponding cell in column H matches any of thouse criterias.
Working code:
Sub BlockAllocationsVlookupAll()
Dim x As Long
Dim lastrow As Long
Dim searchCriterias As String
Dim wb As Workbook
Dim ws As Worksheet
'specify correct path to your workbook
Set wb = Workbooks.Open("C:\Allocations.xls")
'If workbook is already opened use next line
'Set wb = Workbooks("Allocations.xls")
Set ws = wb.Worksheets("Current Day")
searchCriterias = "|OLY|SVC|SVC-PRO|SVC-QUO|EUR|EUR-PRO|EUR-QUO|"
With ws
lastrow = .Cells(.Rows.Count, "H").End(xlUp).Row
For x = 4 To lastrow
If InStr(1, searchCriterias, "|" & .Range("H" & x) & "|") > 0 Then
.Range("I" & x).Formula = "=VLOOKUP(A" & x & ",'[001 - Allocations - Blocks.xls]CurrentDayAll'!$A:$I,9,FALSE)"
End If
Next
End With
'Comment next line if you don't want to close wb
wb.Close (True)
Set wb = Nothing
End Sub

Related

Excel Load Data button

I have a work sheet (Stored Jobs) that I have a macro that will save all the jobs data to. I am now attempting to make a macro that will reload that saved data Based On the job number entered into F9 on the MHBD work sheet the job number sits in column B. I need f to be returned as the row number that the job sits on so that I can copy data from that row into different cells on the MHBD sheet. I cant just copy the row straight because the data on the MHBD sheet is not in a row its scattered. How do I get it to return the row that the job lives on and use that to copy cells off of that row?
Sub Load_Button()
Dim StoredJobs As Worksheet
Dim MHBD As Worksheet
Dim lastRow As Long
Dim f As Range, theJob
Set StoredJobs = Worksheets("Stored Jobs")
Set MHBD = Worksheets("Manual Hour Break Down")
lastRow = StoredJobs.Range("B" & Rows.Count).End(xlUp).Row
theJob = MHBD.Range("F9").Value
'find the current job if it exists
Set f = StoredJobs.Range("B4:B" & lastRow).Find(what:=theJob, lookat:=xlWhole).Row
'if not found, use the next empty row
If f Is Nothing Then MsgBox "Job has not been entered."
End Sub
Got it. #johnColeman you were correct on removing .Row
Thanks everyone else for the ideas and help.
Sub Load_Button()
Dim StoredJobs As Worksheet
Dim MHBD As Worksheet
Dim lastRow As Long
Dim f As Range, theJob
Set StoredJobs = Worksheets("Stored Jobs")
Set MHBD = Worksheets("Manual Hours Break Down")
lastRow = StoredJobs.Range("B" & Rows.Count).End(xlUp).Row
theJob = MHBD.Range("F9").Value
'find the current job if it exists
Set f = StoredJobs.Range("B4:B" & lastRow).Find(what:=theJob, lookat:=xlWhole)
'if not found, error message
If f Is Nothing Then
MsgBox "Job: " & MHBD.Range("F9").Value & " has not been entered" & vbNewLine & "Try the Quote Number"
'if found, copy data
Else
StoredJobs.Range("C" & (f.Row)).Copy
MHBD.Range("B3").PasteSpecial xlPasteValues
End If
End Sub

VBA partly copy from workbook x to workbook y

I'm really bad at VBA (kind of understand when reading the code, but I cannot write it myself).
I would like to create a report file in workbook y that copies part of the data present in workbook x.
I based my current code on the two following articles: Copy from one workbook and paste into another
and Copy value & offset from workbook X to workbook Y only when range value > 0, then loop for remaining rows
I get no error messages with my code, but it doesn't do anything (except open the files). I double-checked the values and the Like, and they seem ok to me.
Any Idea why it doesn't work?
Changed my names & path for anonymity, but here it is:
Private Sub CommandButton1_Click()
Dim x As Workbook
Dim y As Workbook
Dim i, LastRow
'## Open both workbooks first:
Set x = Workbooks.Open("C:\filedestination\filex.xlsx")
Set y = Workbooks.Open("C:\filedestination\filey.xlsm")
'Now, copy what I want from x to y:
LastRow = x.Sheets("Sheetname1").Range("A" & Rows.Count).End(xlUp).Row
y.Sheets("Sheetname2").Range("A2:N5000").ClearContents
For i = 2 To LastRow
If x.Sheets("Sheetname1").Cells(i, "D").Value = "Fixedtext" And x.Sheets("Sheetname1").Cells(i, "F").Value Like "*Subject ?ompensation" Then
x.Sheets("Sheetname1").Cells(i, "D").EntireRow.Copy Destination:=y.Sheets("Sheetname2").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
'Close x:
x.Close
End Sub
Thanks
Two things can be wrong:
LastRow can be 1, thus it does not enter the loop.
Possibly it does not enter in the if clause.
Use the following code to find out which is wrong:
Private Sub CommandButton1_Click()
Dim x As Workbook
Dim y As Workbook
Dim i As Long, LastRow as Long
'## Open both workbooks first:
Set x = Workbooks.Open("C:\filedestination\filex.xlsx")
Set y = Workbooks.Open("C:\filedestination\filey.xlsm")
'Now, copy what I want from x to y:
LastRow = x.Sheets("Sheetname1").Range("A" & Rows.Count).End(xlUp).Row
debug.print LastRow
y.Sheets("Sheetname2").Range("A2:N5000").ClearContents
For i = 2 To LastRow
If x.Sheets("Sheetname1").Cells(i, "D").Value = "Fixedtext" And x.Sheets("Sheetname1").Cells(i, "F").Value Like "*Subject ?ompensation" Then
Debug.Print "Entered in the if"
x.Sheets("Sheetname1").Cells(i, "D").EntireRow.Copy Destination:=y.Sheets("Sheetname2").Range("A" & Rows.Count).End(xlUp).Offset(1)
else
Debug.Print "Did not enter for " ;i
End If
Next i
'Close x:
x.Close
End Sub

How to keep record of cell changing in vba

Program Description I want this program to msgbox every time when cell is changing. For ex. If i have AAA in row1 and row2 BBB i want my code to recognize when cell is changing from one string to another string.
Problem I never used change function before so i don't know where to use it in my code. Can anyone help me out with how to use change function or any other ways to keep track of string changing. Somehow my change function not working.
Sub xym()
Dim x As String, dtext, lastrow As Long, ws1 As Worksheet, wb As Workbook
Dim rangnum As Range, i As Long
Set wb = ActiveWorkbook
Set ws1 = wb.Worksheets("Sheet1")
lastrow = ws1.UsedRange.Rows.Count + 1
Set rangenum = ws1.Range("A1:A" & lastrow)
dtext = rangenum.Value
For i = 1 To UBound(dtext, 1)
If dtext(i,1).change then msgbox "yes"
Next i
End Sub
Please try this:
Sub xym()
Dim i&, v
With Sheet1.[a1]
v = .Resize(.Item(.Parent.Rows.Count).End(xlUp)(2).Row)
End With
For i = 2 To UBound(v) - 1
If v(i, 1) <> v(i - 1, 1) Then
MsgBox "Yes." & vbLf & "Cell A" & i & " is different."
End If
Next
End Sub
You need to use the Worksheet Change Event - there is a clear explanation of how to use this event on the following page, including how to only respond to changes that happen in certain cells.
Excel VBA: Automatically Run Excel Macros When a Cell Changes/Enter Data. Worksheet Change Event
http://www.ozgrid.com/VBA/run-macros-change.htm

I need to create new sheets based on unique names found in column A. Current Code generates excess data in certain sheets

I have the following code so far based on questions asked by other people.
I have a set of names listed in column A, and 216 columns and 9725 rows of data.
Currently using the following code I get the new sheets created except along with the unique names and its relevant data I get many cells filled with "#N/A".
In certain cases, the name Bob for example will be populated in a new sheet called Bob but the first column will have Bob and all relevant data and once all Bobs rows are shown it is follower with many rows with #N/A and all columns with #N/A.
In other cases the sheet will be created for Charles and all of Charles data will be listed, then many rows of #N/A and then all of the master-data including other peoples names which I need to avoid.
I want each individual sheet to only have the info based on the name of the person on that sheet. All of the data gets copied as I verified the number of accurate cells that get populated yet I get these #N/A cells and duplicated extra data and I'm not sure how to stop it from being populated? Any help in cleaning the code would be appreciated!!
Code:
Sub CopyDataFromReportToIndividualSheets()
Dim ws As Worksheet
Set ws = Sheets("FormulaMSheet2")
Dim LastRow As Long
Dim MyRange As Range
Worksheets("FormulaMSheet2").Activate
LastRow = Range("A" & ws.Rows.Count).End(xlUp).Row
' stop processing if we don't have any data
If LastRow < 2 Then Exit Sub
Application.ScreenUpdating = False
' SortMasterList LastRow, ws
CopyDataToSheets LastRow, ws
ws.Select
Application.ScreenUpdating = True
End Sub
Sub SortMasterList(LastRow As Long, ws As Worksheet)
ws.Range("A2:BO" & LastRow).Sort Key1:=ws.Range("A1")
', Key2:=ws.Range("B1")
End Sub
Sub CopyDataToSheets(LastRow As Long, src As Worksheet)
Dim allAgentNameCells As Range
Dim cell As Range
Dim Series As String
Dim SeriesStart As Long
Dim SeriesLast As Long
Set allAgentNameCells = Range("A2:A" & LastRow)
SeriesStart = 2
Series = Range("A" & SeriesStart).Value
For Each cell In allAgentNameCells
If cell.Value <> " " And cell.Value <> "" Then
' Condition ` And cell.Value <> "" ` added for my testdata. If you don't need this, please remove.
' Current Row's Series not SPACE
If cell.Value <> Series Then
SeriesLast = cell.Row - 1
CopySeriesToNewSheet src, SeriesStart, SeriesLast, Series
Series = cell.Value
SeriesStart = cell.Row
End If
End If
Next
'' copy the last series
SeriesLast = LastRow
CopySeriesToNewSheet src, SeriesStart, SeriesLast, Series
End Sub
Sub CopySeriesToNewSheet(src As Worksheet, Start As Long, Last As Long, name As String)
Dim tgt As Worksheet
Dim MyRange As Range
If (SheetExists(name)) Then
MsgBox "Sheet " & name & " already exists. " _
& "Please delete or move existing sheets before" _
& " copying data from the Master List.", vbCritical, _
"Time Series Parser"
End
Else
If Series = " " Then
End
End If
End If
Worksheets("FormulaMSheet2").Activate
' Worksheets.Add(after:=Worksheets(Worksheets.Count)).name = name
Worksheets("FormulaMSheet2").Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.name = name
Set tgt = Sheets(name)
' copy data from src to tgt
tgt.Range("A2:BO2" & Last - Start + 2).Value = src.Range("A" & Start & ":BO" & Last).Value
End Sub
Function SheetExists(name As String) As Boolean
Dim ws As Variant
For Each ws In ThisWorkbook.Sheets
If ws.name = name Then
SheetExists = True
Exit Function
End If
Next
SheetExists = False
End Function
You need replace the
tgt.Range("A2:BO2" & Last - Start + 2).Value = src.Range("A" & Start & ":BO" & Last).Value
to
src.Range("A" & Start & ":BO" & Last).SpecialCells(xlCellTypeVisible).Copy Destination:=tgt.Range("A2:BO2" & Last - Start + 2)
I found what I needed at the following site: http://www.rondebruin.nl/win/s3/win006_5.htm .
I figured if anyone else was looking for similar code it would help taking a look at the site.

How to return value from VLOOKUP into a cell?

I have the following piece of code for Vlookup. The function works fine but the found out value aint getting displayed in the cell. However if i had a used Msgbox function the found out value is shown. The question is doesnt VLOOKUP result be captured in a cell?
Sub Example_of_Vlookup()
Dim lookFor As Range
Dim rng As Range
Dim col As Integer
Dim found As String
Dim lastrowrange As Long
Dim area As Range
lastrowrange = [A65536].End(xlUp).Row
Set lookFor = Sheets("Sheet2").Range("b2")
Set rng = Sheets("Sheet2").Columns("t:u")
Set taxRange = Range("f2", Cells(lastrowrange, 22))
col = 2
On Error Resume Next
For i = 1 To lastrowrange
found = Application.VLookup("B2", "T1:U4", 2, True)
If IsError(found) Then
MsgBox lookFor & " not found"
Else
area.Cells(i, 2).Value = found
End If
Next i
On Error GoTo 0
End Sub
You did not set the range "area" equal to anything, so this line won't show your answer properly:
area.Cells(i, 2).Value = found
Change area.Cells(i,2).value to sheets("Sheet2").Cells(i,2).value or wherever you want your answer to show. Or, set area equal to something if you want to use area.cells.
Idea is simple - I have country names in Column B.Inention is to pull out the Area under which country belongs - My look up values are in column S(country) and T(area) and display the result in column F – Sayanth Sasidharan 25 mins ago
If my understanding is correct as per your explanation then you do not need to use a loop. Let Excel do the Dirty Work ;) You will end up with far less code.
Let's say your sheet looks like this
Logic:
Find the last row of Col B
Insert the Vlookup formula in F1:F & LastRow in one go
Convert them to values.
Code:
Option Explicit
Sub Example_of_Vlookup()
Dim ws As Worksheet
Dim lRow As Long
Set ws = ThisWorkbook.Sheets("Sheet2")
With ws
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
'~~> =IF(ISERROR(VLOOKUP(B1,S:T,2,0)),"",VLOOKUP(B1,S:T,2,0))
.Range("F1:F" & lRow).Formula = _
"=IF(ISERROR(VLOOKUP(RC[-4],C[13]:C[14],2,0)),"""",VLOOKUP(RC[-4],C[13]:C[14],2,0))"
.Range("F1:F" & lRow).Value = .Range("F1:F" & lRow).Value
End With
End Sub
Result: