I am trying to implement a lookup feature in Excel Vba. I do not have any code to share because I am uncertain how to begin with the implementation.
Upon opening a workbook I want to use VBA to enter today's date into the next available row in column A - which I currently have working now. However, at that point in Column B on that same line, I to find a stock rate in a table I have, where J2 is the date and J3 is the price of the stock.
What I think I need is a formula where I can lookup the date I just added in this table and then retrieve the price relevant to that date. I understand Vlookups in Excel very well; it is I just do understand how to use a lookup here for each next available line.
Here is my code for the dates:
Dim rnum as integer
rnum = sheet17.usedrange.cells.rows.count +1
sheet17.cells(rnum, 1).value = date
I am seeking lookup functionality relative to (rnum, 2) as the next available line.
If you want to hardcode it, that'd be
sheet17.cells(rnum, 2).formula = "=vlookup(" & sheet17.cells(rnum, 1).address(false,false,xlA1) & ", $J:$K, 2, false)"
If you would prefer to use whatever formula is on the previous line,
sheet17.range(sheet17.cells(rnum-1, 2), sheet17.cells(rnum, 2)).FillDown
I'm assuming when you say "stock rate in a table" you mean "stock rate in a worksheet" and also assume that the values in column J contain the stock rates for the same stock. In other words, you are only matching on a date in that column and not the stock symbol AND the date. (Please let me know if I have these assumptions wrong).
That being, said you can try the following formula in column B:
=IF(A50<>"",INDEX(J:J,MATCH(A50,StockSheet!J:J,0) +1),"")
In this case, the formula is in cell B50 and assumes the new date is in A50. It says given the date value in cell J + n, give me the value in cell J + n + 1.
I added a small validation check to see if there was a value in A50, but you may want to go deeper than that.
Also, if you want to make the value in B50 static, then just use the following code:
Sub mySub()
Dim x As Range 'I assume this range will be for your currentm, working worksheet
Set x = Range("B50", "B50")
x.Formula = "=IF(A50<>"""",INDEX(J:J,MATCH(A50,Codes!J:J,0) +1),"""")"
x = x.Value
End Sub
Related
I am fairly new at VBA and I am currently trying to rework an existing macro that sums hours of a workday up by employee for the week.
I need a macro that will sum up the work hours by just a single day instead of a weekly total. There are two entries per day for each employee. Then, this total is copy and pasted into a different column.
I can not use a pivot table as this macro will be used on a different spreadsheet every week. I also can not have a reference sheet. This is going to be applied to a spreadsheet that is emailed every week, so it is constantly changing.
Basically... if the date in Column B is the same, I need the sum of hours in Column C, then that Sum is pasted over to a new column (D is fine).
Below is what the original report looks like at this point:
A B C
Joe Smith -- 03/26/2018 -- 3.65
Joe Smith -- 03/26/2018 -- 4.46
Joe Smith -- 03/27/2018 -- 5.45
Joe Smith -- 03/27/2018 -- 2.93
The existing macro is :
For Each x In n.Range(n.Range("B2"), n.Range("B" & Rows.Count).End(xlUp))
x.Value = Month(x.Value) & "/" & Day(x.Value) & "/" & Year(x.Value)
Next x
For Each x In n.Range(n.Range("J2"), n.Range("J" & Rows.Count).End(xlUp))
Set r = n.Range(x.Address)
r.Offset(0, 1).Value =
Format(Application.WorksheetFunction.Max(n.Range(n.Range("B2"), n.Range ("B" & Rows.Count).End(xlUp))), "MM/DD/YYYY")
r.Offset(0, 2).Value = Application.WorksheetFunction.SumIf(n.Range("A:A"), x.Value, n.Range("E:E"))
For I = 3 To UBound(TableHeaders)
ch = TableHeaders(I)
r.Offset(0, I).Value = Application.WorksheetFunction.SumIfs(a.Range("R:R"),
a.Range("L:L"), ch, a.Range("A:A"), x.Value)
Next I
d.RemoveAll
Next x
I can not use a pivot table as this macro will be used on a different
spreadsheet every week.
well, this is not a reason. You could run change source for pivot table any time.
This is going to be applied to a spreadsheet that is emailed every week
But at least layout of the workbooks is preserved?
The simplest way is to use formula:
=SUMIFS(C:C, A:A, A2, B:B, B2)
Paste it to D2 and drag down. You could also put formulas to A:C that just refers to proper values in source file, like:
=[WorkbookFromEmail.xlsx]Sheet1!A2
and drag it left to C and down to as many rows as you think you will need and some more. Then you could only change the name of linked file in Data/Edit Links.
As far, you don't need VBA. But you could make some macro for refreshing links to other workbook if you found manual job too troubling. This is however different story.
Alternatively, you could save the source file always under the same name, like BookFromMail.xlsx and then open the master file with formulas and refresh it.
Here's an all code way. You'll have to adjust the code to find the range you want to read and also figure out where to write to.
Sub SumEeDays()
Dim vaValues As Variant
Dim i As Long
Dim dc As Scripting.Dictionary
Dim sKey As String
'set a reference to the MS Scripting Runtime
'then you wont get an error on this line
Set dc = New Scripting.Dictionary
'Make a 2d array of the values you want process
vaValues = Sheet1.Range("a1").CurrentRegion.Value
'loop through the 2d array
For i = LBound(vaValues, 1) To UBound(vaValues, 1)
'create a unique key to keep track of ee name and date
sKey = vaValues(i, 1) & "||" & vaValues(i, 2)
If dc.Exists(sKey) Then
'If the key already exists, add the hours to what's there
dc.Item(sKey) = dc.Item(sKey) + vaValues(i, 3)
Else
'If the key doesn't exist, create it and add the hours
dc.Add sKey, vaValues(i, 3)
End If
Next i
'Loop through the dictionary of unique name/dates
For i = 1 To dc.Count
With Sheet1.Range("J1")
'Keys returns an array and Split splits it on "||"
'The 0th element of the array is the name
'The 1st element is the date
.Offset(i - 1, 0).Value = Split(dc.Keys(i - 1), "||")(0)
.Offset(i - 1, 1).Value = Split(dc.Keys(i - 1), "||")(1)
.Offset(i - 1, 2).Value = dc.Items(i - 1)
End With
Next i
End Sub
Hi i need help on creating a VBA to copy range of cells repeatedly with one column having increments.
Current data
Expected Output
I found a vba but will only copy the rows based on column C without increments on the date
Excel VBA automation - copy row "x" number of times based on cell value
I'm not sure why you would need to do this as excel has built-pattern pattern recognition for these scenarios, after entering two succesive dates if you hover over and click the border of the cell then drag down, the desired date range will appear in the column automatically.
If you still insist on doing this programatically for whatever reason then your question already has multiply feasible solutions here: Add one day to date in cells using VBA
Specify each cell in turn then increment the value by the corresponding row number to return desired date range in column A:
Range("A2").Value = Range("A2").Value + 2 ' add 2 days
Range("A3").Value = Range("A3").Value + 3 ' add 3 days
Range("A4").Value = Range("A4").Value + 4 ' add 4 days
'-------- So on and so forth until desired range is acheived --------'
or alternatively:
Range("A2").value = DateAdd("d", 2, CDate(Range("A2")))
Range("A3").value = DateAdd("d", 3, CDate(Range("A3")))
Speaking as someone who had to learn the hard way, please take my advice and ensure you research your problem thouroughly to find a solution before posting. Refer to the guidelines here if needed.
I'll outline the steps I'm trying to accomplish:
1) Search through a spreadsheet for an acct # via match.
2) If it exists, I'd add offset #__ cells to the right and select that cell.
3) Set the selected cell's formula to Concatenate("ColumnLetter&Match(A1:A1000"",0) + Concatenate("ColumnLetter&Match(A1:A1000"",0)
FX Debt 1,000
Fx Equity 2000
U.S Debt 4,000
U.S Loans 5,000
Recon 1 Recon 2 Diff
11111 $ Debt 0
11112 FX Debt
So, I'd search for, say account "11111" using =match(A1:1000, "11111", 0). If it exists I'd offset to the right of it and then select that cell. I'd then add a formula to the selected cell which would add Cell references.
I'm thinking it would look something alone the lines of:
If Match(A1:A1000,"11111",0)=true
Select(A&(result from match))
Offset(three to right).select
edit
So to make the next step less ambiguous I'll separate it from the rest of the code sample...First let me explain the goal with it, though. The sample data above is divided into two tables...With the first table ending, for example with the general account U.S Loans --- 5,000. The second starting with the Acct # and Recon 1. My goal is to add certain cells that contain the values (not the values themselves, I want to be able to trace back to the accounts using precedents and dependents) of the general acct's in the first table into the selected offset cell. The way I thought I'd go about this was to search for the acct name, for example "FX Debt", the same way David suggested to find the Acct #, I'd then use the similar offset method to add the cell containing 1000, so say B2, into the original offset sell to the right of the Account #.
end edit
edit 2
Dim searchRange as Range
Dim myMatch as Variant
Set searchRange = Range("A1:A1000")
myMatch = Match("11111", searchRange, 0)
If Not IsError(myMatch) Then
rng.Cells(myMatch).Offset(,3).Formula = Sum(Match("U.S Debt", searchRange, 0).Offset(,2)+(Match("U.S Debt", searchRange, 0).Offset(,2))...
End If
Does this make more sense? I'm trying to add the amounts associated with U.S Debt and U.S Loans to the master account ($ Debt).
end edit 2
1) Search through a spreadsheet for an acct # via match.
2) If it exists, I'd add offset #__ cells to the right and select that
cell.
3) Set the selected the cell's formula to
Concatenate("ColumnLetter&Match(A1:A1000"",0) +
Concatenate("ColumnLetter&Match(A1:A1000"",0)
Don't bother with Selecting the cell. It's unnecessary about 99% of the time (probably more). More detail, here:
How to avoid using Select in Excel VBA macros
Also, your Match syntax is wrong. You need to do:
=Match("11111", A1:A1000, 0)
So, putting it all together, something like:
Dim searchRange as Range
Dim myMatch as Variant
Set searchRange = Range("A1:A1000")
myMatch = Match("11111", searchRange, 0)
If Not IsError(myMatch) Then
searchRange.Cells(myMatch).Offset(,3).Formula = ...
End If
I did not attempt to interpret the formula string given below; I'm not sure I understand what it's supposed to be doing:
sum(((Column Number -->)"I" + match(A1:A1000,"",0)+("I"+match(A1:A1000,"",0))
But at the very least we can consolidate your pseudo-code using the myMatch variable:
sum(((Column Number -->)"I" + myMatch+("I"+myMatch)
(A word of caution: the + operator can be used to concatenate strings, but there are several reasons why the & operator is preferable, notably the + operator is ambiguous and defaults to a mathematical + operator when one of the arguments is a numeric type. In other words, it attempts to add a number and a string, which will invariable result in a Mismatch error)
So revise to:
sum(((Column Number -->)"I" & myMatch & ("I"& myMatch)
Even after cleaning it up, I'm still not sure what you're trying to do with the above formula, but if you can try to explain then I can probably assist.
Ok so here's a doosy of a question:
I work in healthcare, currently I have a workbook that references values using an INDEX:MATCH function based off of a patients name, which I manually enter. I pull 7/10 columns using this method automatically. The 8th column is the generation date of the information and the 9th column is a date/time stamp from another sheet which I enter manually based off of the patient's room number.
Here's the tricky part. The two reports, which I'm pulling from our bed management program Allscripts, don't translate the bed names/numbers the same way. So I created a translation table in a different sheet. My question is this: Is there a way I can use a function like INDEX:MATCH, VLOOKUP or something else within either Excel or VBA to reference my translation table in order to look up the bed name/number and auto fill the information I need?
Spreadsheet looks like this:
https://docs.google.com/spreadsheets/d/1j8b2jZ7ZUzKpmoqoisFBVccDKw_CWDfWCGL_CcO2hCo/edit?usp=sharing
So Column G on the 'Raw Data Page' needs to reference column E from the same page, translate that bed name based off of the 'Bed Translation Page' and then look up the date/time information from the 'Job Activity Detail' page in Column G for that translated bed. The catch is the bed names are repeated over 100k times in my current workbook due to the day by day entry of data (I manually change the search range in the INDEX:MATCH function for each column).
I hope someone can shed some light on this for me, it's been the bane of my existence for nearly two years now! Appreciate any info/help any of you may be able to provide! :)
Great news man, you will not need this so! It pulls in column G from the job activity detail, where the identifier on rawdata page is equal to the identifier on job activity detail and the name is the same on Job Activity Detail and Portal of Entry Detail and the two times in J and M of the respective sheets match.
Option Explicit
Sub bd()
Dim rdsheet As Worksheet, jbsheet As Worksheet, btsheet As Worksheet
Dim bdstr, bdendrow, rng As Range, y, Key, GCell, BdCell
Set rdsheet = Sheets("Raw Data Page")
Set jbsheet = Sheets("Job Activity Detail")
Set btsheet = Sheets("Portal of Entry Detail")
bdstr = rdsheet.Range("G3").Address
bdendrow = rdsheet.Range("A3").End(xlDown).Row
Set rng = rdsheet.Range(bdstr & ":G" & bdendrow)
For Each y In rng
If IsEmpty(y) Then
Key = y.Offset(0, -2).Value
Key = Replace(Key, "-", "")
Set GCell = jbsheet.Range("A:A").Find(what:=Key, LookAt:=xlPart)
Set BdCell = btsheet.Range("B:B").Find(what:=y.Offset(0, -4).Value, LookAt:=xlPart)
If Not GCell Is Nothing And btsheet.Range("J" & BdCell.Row).Value = jbsheet.Range("M" & GCell.Row).Value Then
rdsheet.Range(y.Address) = jbsheet.Range("G" & GCell.Row)
End If
End If
Next y
End Sub
{=INDEX('Job Activity Detail'!$G$106463:$G$106689,MATCH('Raw Data Page'!E15459&H15459,'Job Activity Detail'!$A$106463:$A$106689&'Job Activity Detail'!$M$106463:$M$106689,0))} looking up the value as an array function with multiple match criteria seems to be working! I appreciate the insight Lowpar! :)
Wording my question is slightly tricky so I've included screen-shots to make this easier. I have 2 separate spreadsheets which are currently not linked together in anyway. What I've been asked to do is:
For the drop-downs which have a * next to them, have this * drop-down get converted into a acronym (I.e. If it's Home Visit *, then this will be converted to HV), and have it automatically entered into Cell Position X. Please refer to Image 1 then Image 2)
So the user would click on Sheet one, select the relevant drop-down field and then assign how much time that task took. The second sheet would then update itself with this information - it would insert the users name, program and activities. This is where it gets very tricky. Based off the drop-down selection, if it is asterisked (*), then based off the field-type it will convert it into a set acronym which would then be placed in one of the data fields based off the entry date that has been provided.
I designed both spread-sheets and they have macros in the background, but I can't seem to work out how to best perform this. Would you suggest a transpose function which checks firstly the date criteria and then an INDEX(MATCH) function to match the criteria against a pre-defined name-range which converts Home Visit etc. to HV automatically? I'm also unsure of how to insert delimiters for each new entry that is read. If anyone can provide help I would be very grateful.
I'm not 100% sure I understand your question, but here goes:
What about adding a Worksheet_Change event to look for changes in the drop-down's cell, and then converting it to an acronym?
Place the following code inside the sheet of interest:
Private Sub Worksheet_Change(ByVal Target As Range)
'If Cell A1 is changed, put the acronym into A2
If Target.Row = 1 And Target.Column = 1 Then
Cells(2, 1) = GetAcronym(Target.Value)
End If
End Sub
Function GetAcronym(TheText As String) As String
Dim result As String
Dim x As Long
'Always grab the first letter
result = Mid(TheText, 1, 1)
'Get the other letters
For x = 2 To Len(TheText) - 1
If Mid(TheText, x, 1) = " " Then result = result & Mid(TheText, x + 1, 1)
Next x
GetAcronym = UCase(result)
End Function