I am trying to pull data out of a large spreadsheet using VBA.
Column A contains ID's which can repeat depending on the data stored in it.
For example i have
ID Value1 Value2
1111 item1 item2
1111 item3 item4
2222 item3 item4
3333 item3 item4
3333 item3 item4
I enter the ID into a spreadsheet then want to use VBA to Vlookup the ID then pull the Values from column B and C into another spreadsheet.
Heres what i have
Sub populate()
Dim ID As String
Dim Value1 As String
ID = Range("D5")
Value1 = Application.WorksheetFunction.VLookup(ID, Worksheets("Required").Range("A4:J1913"), 2, False)
Response = Application.WorksheetFunction.VLookup(ID, Worksheets("Required").Range("A4:J1913"), 7, False)
Worksheets("Coversheet").Range("D8") = Value1
Worksheets("Coversheet").Range("D10") = Value2
Dim Value1address As Long
Value1address = VarPtr(Value1)
Worksheets("Coversheet").Range("D15").Value = Cells(Value1address).Offset(1, 0)
End Sub
The code works excatly how i want, except for the last 3 lines. I am trying to get an offset from Value1 by 1 row, however it is saving as a blank, and consequently puts a blank value into Cell D15.
Can anyone help me solve this problem, or how i can easily take data from the following rows after the Vlookup?
Use the worksheet's MATCH function to return the row number to an INDEX function while adding +1 to it.
with Worksheets("Required")
Worksheets("Coversheet").Range("D15").Value = _
Application.Index(.Range("B4:B1913"), Application.Match(ID, .Range("A4:A1913"), 0) + 1))
End With
If you are finding the row, then store it and keep reusing it.
Dim ID As String, val1 As String, val2 As String, val3 As String, rw As Long
ID = Range("D5")
With Worksheets("Required")
If Not IsError(Application.Match(ID, .Range("A4:A1913"), 0)) Then
rw = Application.Match(ID, .Range("A4:J1913"), 0)
val1 = .Cells(rw + 3, 2).Value
val2 = .Cells(rw + 3, 7).Value
val3 = .Cells(rw + 4, 2).Value
End If
End With
With Worksheets("Coversheet")
.Range("D8") = val1
.Range("D10") = val2
.Range("D15") = val3
End With
Native Worksheet formulas
This could also be handled by standard (non-array) worksheet formula. In D8, D10 and D15 as,
=INDEX(Required!$B$4:$B$914, MATCH($D$5, Required!$A$4:$A$914, 0))
=INDEX(Required!$J$4:$J$914, MATCH($D$5, Required!$A$4:$A$914, 0))
=IFERROR(INDEX(Required!$B$4:$B$914, AGGREGATE(15, 6, ROW($1:$911)/(Required!$A$4:$A$914=$D$5), 2)), "n/a")
I recommend using Power Query for this task (or Get&Transform if you're on 2016 already):
https://www.dropbox.com/s/my59casl9y8ac3y/SO_ExtractDataUsingVLookupAndOffset.xlsx?dl=0
Code is pretty short (i.e. for Var1):
let
Filter= Excel.CurrentWorkbook(){[Name="ID"]}[Content][Column1]{0},
Source = Excel.CurrentWorkbook(){[Name="Tabelle1"]}[Content],
#"Filtered Rows" = Table.SelectRows(Source, each [ID] = Filter)
in
#"Filtered Rows"
You have all formatting options for the output and the solution is fully dynamic:
Related
Sub Table1()
Dim FirstTable As Table
Dim value1, value2 As Integer
Set FirstTable = ActiveDocument.Tables(1)
iLastRow = FirstTable.Rows.Count
value1 = Left(FirstTable.Rows(1).Cells(2).Range.Text, Len(FirstTable.Rows(1).Cells(2).Range.Text) - 2)
value2 = Left(FirstTable.Rows(2).Cells(2).Range.Text, Len(FirstTable.Rows(2).Cells(2).Range.Text) - 2)
Total = value1 + value2
End Sub
this was something I was trying to write and an error was occurring due to the vertically merged cells
I have 2d-array like this below. There are 26 values from 1-26, but also "bigger" categories, e.g. 2nd value: "Important", "very important", "extremely important", and are all classified as "check".
Can I integrate this into this Array like adding after "important: priority (1,3)? Or (2,3) Sorry, I am starting with Arrays.... I do not fully understand this yet. The values I then want to populate into columns. Example, if column = 1 then column2 = "Important" and column3 = "check" and so on.
Dim Priority(1 To 26, 1 To 2)
Priority(1, 1) = 1: Priority(1, 2) = "Important"
For Each Zelle In Range(Cells(FirstRow + 2, 14), Cells(LastRow, 14))
Zelle.Offset(0, 1) = Application.VLookup(Zelle, Priority, 3, False)
Zelle.Value = Application.VLookup(Zelle, Priority, 2, False)
'Zelle = IIf(IsError(Zelle), "???", "Zelle")
Next Zelle
it checks CellX and then goes directly to CellX+1 and so on...I am sure this could be also done with For i Loop
My purpose is to split a task into constituent tasks and find the most important one.The macro is written in "May" sheet of workallotment.xlsm and the tasks are in tasks.xlsx
For example:
Constituents Constituents Important Imp
Praveen T1 T2 T3 T4 T5 T6 T1+T2+T3 =T5 T3+T5+T6 =T9 T1 T6
4 3 1 2 8 9
Karthik P1 P2 P3 P4 " among T1,T2,T3- T1 takes more time".its imp
6 3 2 2
Walter c1 c2 c3 c4
1 2 3 4
Arvind g1 g2 g3
2 1 3
Sreelatha h1 h2 h3
2 1 1
Code:
Sub workallotment()
Dim workallotmentWB, tasksWB As Workbook
Dim waSheet As Worksheet
Dim str(9) As String
Dim splitArray() As String, S(10) As String
Dim col_new As Integer
Dim wa_nameRng As Range
Dim r As Integer, max As Integer, imps As String
Dim wa_nameRow, wa_firstRow, wa_lastRow As Integer 'work allotment rows
Dim t_firstRow, t_lastrow As Integer 'task rows
Dim curTaskCol As Integer 'current task column
Dim wa_tmpcol As Integer 'work allotment, temp column
Set workallotmentWB = ThisWorkbook
Set tasksWB = Workbooks.Open("E:/tasks.xlsx")
'notes on data structure:
'- tasks workbook:
'first name starts in A1 of "Sheet1"
'- workallotment workbook:
'first name starts in A2 of Sheet named "workallotment"
'tasks are to be written starting in B2
'in Row 1 are headers (number of days)
t_firstRow = 1
wa_firstRow = 2
wa_nameRow = 0
Set waSheet = workallotmentWB.Worksheets("May") ' in this file - workallotment.xlsm
With tasksWB.Worksheets("May") ' in tasks.xlsx which is attached
'finding the last rows
t_lastrow = .Range("A1000000").End(xlUp).row + 1
wa_lastRow = waSheet.Range("A1000000").End(xlUp).row
'goes through all the names in tasks_Sheet1
For r = t_firstRow To t_lastrow Step 2
Set wa_nameRng = waSheet.Range("A:A").find(.Range("A" & r).Value, _
LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
If Not wa_nameRng Is Nothing Then
wa_nameRow = wa_nameRng.row
curTaskCol = 2
wa_tmpcol = 2
Do While Not IsEmpty(.Cells(r, curTaskCol).Value)
For C = 1 To .Cells(r + 1, curTaskCol).Value
waSheet.Cells(wa_nameRow, wa_tmpcol).Value = .Cells(r, curTaskCol).Value
wa_tmpcol = wa_tmpcol + 1
Next C
curTaskCol = curTaskCol + 1
Loop
End If
Next r
End With
MsgBox ("done")
For r = t_firstRow To t_lastrow Step 2 ' loop to find importance
col = 2 'setting to initial col
curTaskCol = 17 ' position input - constituent jobs at 17th col in tasks.xls
Do While Not IsEmpty(tasksWB.Worksheets("May").Cells(r, curTaskCol).Value)
str(curTaskCol - 16) = tasksWB.Worksheets("May").Cells(r, curTaskCol).Value
' reading input to first array of string element
substr = Left(str(curTaskCol - 16), Application.WorksheetFunction.find("=", str(curTaskCol - 16)) - 1) ' if T1+T2=T3 it'll look before "=" symbol
MsgBox (substr)
splitArray() = Split(substr, "+") ' if T1+T2 it will be split as T1 & T2
For i = LBound(splitArray) To UBound(splitArray)
S(i + 1) = splitArray(i) ' assigning split elements to string array
Next i
For i = LBound(splitArray) To UBound(splitArray)
col_new = 2 ' checking from 2nd column
Do While Not IsEmpty(tasksWB.Worksheets("May").Cells(r, col_new).Value)
If (S(i + 1) = tasksWB.Worksheets("May").Cells(r, col_new).Value) Then 'initialising max and imps
imps = S(i + 1) ' most important job
max = tasksWB.Worksheets("May").Cells(r + 1, col_new).Value
End If ' maximum time taken for task
col_new = col_new + 1
Loop
For j = LBound(splitArray) To UBound(splitArray)
col_new = findcol(S(j + 1), r, tasksWB)
If (max < tasksWB.Worksheets("May").Cells(r + 1, col_new).Value) Then
max = tasksWB.Worksheets("May").Cells(r + 1, col_new).Value
imps = tasksWB.Worksheets("May").Cells(r, col_new).Value
End If
Next j
Next i
tasksWB.Worksheets("May").Cells(r, curTaskCol + 6).Value = imps
' assign most IMPORTANT task on 6th column from current column
curTaskCol = curTaskCol + 1 ' RUNTIME ERROR 1004
Loop
Next r
End Sub
Public Function findcol(S As String, row As Integer, theWB As Workbook) As Integer
Dim col As Integer, addr As Integer
col = 2 ' checking from column 2
'Set tasksWB = Workbooks.Open("E:/tasks.xlsx")
Do While Not IsEmpty(theWB.Worksheets("May").Cells(row, col).Value)
If (StrComp(Trim(S), Trim(theWB.Worksheets("May").Cells(row, col).Value)) = 0) Then
addr = col ' if task string is found in column
End If
col = col + 1 ' return column found
Loop
findcol = addr
End Function
Krishnan,
In your main proc workallotment you declare the variable tasksWB.
In your method 'findcol' you then reference tasksWB. It looks like you've pulled this code out of the main proc. The tasksWB only has scope within workallot and so you need to give findcol this object so it will have it within it's scope as well.
I would recommend that you pass the tasksWB into the method, as a third parameter.
Your method would then look as follows.
Edit for your comment of why findcol doesn't return. The Exit Function will ensure that the method is exited immediately after setting the return value. Without this you would end up in the asking for the correct task name again.
Public Function findcol(S As String, row As Integer, theWB as Workbook) As Integer
col = 2 ' checking from column 2
Do While Not IsEmpty(theWB.Worksheets("May").Cells(row, col).Value)
If (S = theWB.Worksheets("May").Cells(row, col).Value) Then
findcol = col ' if task string is found in column
Exit Function
End If
'MsgBox ("Enter correct task names") Not sure why this is here.
col = col + 1 ' return column found
Loop
End Function
and you'd call it with
col_new = findcol(S(j + 1), r, tasksWB) ' ERROR line function to find column of task string
This will ensure that you do not "leak" your variable definition into global scope, and that you also ensure that your method doesn't depend on external globals.
Edit 3:
Your findcol is still wrong.
Public Function findcol(S As String, row As Integer, theWB As Workbook) As Integer
Dim col As Integer
'******* you don't need this because you can exit early
'Dim addr As Integer
col = 2 ' checking from column 2
'***** THIS LINE NEEDS TO BE REMOVED because you are using theWB being passed in *****
'Set tasksWB = Workbooks.Open("E:/tasks.xlsx")
Do While Not IsEmpty(theWB.Worksheets("May").Cells(row, col).Value)
'****** this line must use theWB
'If (StrComp(Trim(S), Trim(tasksWB.Worksheets("May").Cells(row, col).Value)) = 0) Then
If (StrComp(Trim(S), Trim(theWB.Worksheets("May").Cells(row, col).Value)) = 0) Then
'************* you can exit early once you've found what you need.
'addr = col ' if task string is found in column
findcol = col
exit function
End If
col = col + 1 ' return column found
Loop
' You can exit early so don't need this.
' findcol = addr
End Function
You should probably do a check when you call the function that the value hasn't returned 0, eg
new_col = findcol( .... )
if new_col = 0 then
msgbox "couldn't find the column with that str" & S(j + 1)
end if
tasksWB isn't recognized in the findcol function as it is declared as Private (=Dim) in the main process.
Declare it at the top of your module, and it'll work! ;)
I am having this class as entity:
public class Something
Property Status as integer
Property DateInit as DateTime
Property DateEnd as DateTime
End Class
I have a generic list with n items of that class. The Structure is:
State DateInit DateEnd
3 10/2/2015 12/2/2015
10 12/4/2015 13/5/2015
22 13/5/2015 2/11/2015
...
I need calculate a formula using DateInit and DateEnd. I have 10 states which forms the row in a grid. In the cell I set the date which state was changed (it is DateInit). DateEnd is the next DateInit date in the row of the cell changed.
Some sample of the grid:
STATUS => 1 3 6 10 15 16 21 22
DATEINIT => null null null 12/4/2015 null null 13/5/2015 null ...
It is the grid.
If I change status I need to set the next DateInit column with value
I report a new Sample, If I have this list:
Dim mylist As New List (Of Something) ()
Dim item1
item1.status = 3
item1.DAteInit = Datetime.parse("10/2/2015")
item1.DAteEnd = Datetime.parse("12/4/2015")
mylist.add(item1)
Dim item2
item2.status = 10
item2.DAteInit = Datetime.parse("10/2/2015")
item2.DAteEnd = Datetime.parse(" 13/5/2015")
mylist.add(item2)
Dim item3
item3.status = 11
item3.DAteInit = Datetime.parse(nothing)
item3.DAteEnd = Datetime.parse(nothing)
mylist.add(item3)
Dim item4
item4.status = 12
item4.DAteInit = Datetime.parse(" 13/5/2015")
item4.DAteEnd = Datetime.parse("10/5/2015")
mylist.add(item4)
Dim item5
item5.status = 15
item5.DAteInit = Datetime.parse("10/5/2015")
item5.DAteEnd = Datetime.parse(" 13/5/2015")
mylist.add(item5)
One case:
If I choice the item 4, I need to get item 5 DataInit to set to DataEnd of item 4.
Other case
If I choice item 4, I need to change previous item with dateend (item 2) and set DateEnd of item2 to DateInit of item 4
If in a few words, If I select one I need previous and next Register with DateEnd different of Nothing
thx
hi what i wanted from some status to calculate, next, current and previous is:
Dim myList as new List(of Something)
Dim calcPrev As BLL.Something = mylist.Linea.TakeWhile(Function (x) x.Status < SomeStatusInserted And x.DateInit isnot nothing).LastOrDefault()
Dim calcCurr As BLL.Something = mylist.Linea.Where(Function (x) x.Status = SomeStatusInserted).FirstOrDefault()
Dim calcNext As BLL.Something = mylist.Linea.SkipWhile(Function (x) x.Status <= SomeStatusInserted And x.DateEnd isnot nothing).FirstOrDefault()
calcPrev.DateEnd = calcCurr.DateInit
calcCurr.DateEnd = calcNext.DateEnd
my objective is to generate a random question ( +, * or -) and an answer when I click a button which I have been able to do. The problem is when I generate it, it returns a question(label) and an answer(MessageBox) but when I click ok on the messageBox it asks another question straight after and once I dismiss that messageBox it stops asking.
Private Sub Generate()
'This is my first random value'
Dim rnd1 As New Random
'This is my Second random Value'
Dim rnd2 As New Random
'This value will decide weather it is a +, * or -'
Dim rnd3 As New Random
'Declaring first value as an integer'
Dim Val1 As Integer
'Declaring second value as an integer'
Dim Val2 As Integer
'This will calculate the answer'
Dim Ans As Double
'This is what I will reference to to display the question'
Dim question As String
'If the random value is equal to 1, the question is an addition'
If (rnd3.Next(1, 3) = 1) Then
Val1 = rnd1.Next(1, 20)
Val2 = rnd2.Next(1, 25)
Ans = Val1 + Val2
question = Val1.ToString() + "+ " + Val2.ToString()
lbl_ques.Text = question
MessageBox.Show("Answer = " + Ans.ToString())
Val1 = 0
Val2 = 0
Ans = 0
question = ""
End If
'If the random value is equal to 2, the question is a multiplication'
If (rnd3.Next(1, 3) = 2) Then
Val1 = rnd1.Next(1, 10)
Val2 = rnd2.Next(1, 17)
Ans = Val1 * Val2
question = Val1.ToString() + "* " + Val2.ToString()
lbl_ques.Text = question
MessageBox.Show("Answer = " + Ans.ToString())
Val1 = 0
Val2 = 0
Ans = 0
question = ""
End If
'If the random value is equal to 3, the question is a subtraction'
If (rnd3.Next(1, 3) = 3) Then
Val1 = rnd1.Next(1, 50)
Val2 = rnd2.Next(1, 43)
Ans = Val1 - Val2
question = Val1.ToString() + "- " + Val2.ToString()
lbl_ques.Text = question
MessageBox.Show("Answer = " + Ans.ToString())
Val1 = 0
Val2 = 0
Ans = 0
question = ""
End If
End Sub
How can I stop it from generating another question and answer straight away? Thanks
P.S If you are wondering why I am using VB it is because its for a school project and has to be in VB :/ I usually use c#
Either use
An exit sub to break out of the current subroutine
If ... Then
Exit Sub
End If
or and ElseIf to only execute one of the If conditions
If ... Then
ElseIf ... Then
End If
or (preferably) a Select case statement
Select Case rnd.Next(1, 3)
Case 1
Case 2
Case 3
End Select
Side note you only need to create one Random object and just call .Next with the appropriate values each time