VLookup the same person multiple dates - vba

I have two spreadsheets:
I want to match both sheets and make sure that dates match for every person. E.g. Person 1 has three different dates and I want to match them exactly 1:1.
Person 1, 3/2/2015 (Table A) -> Person 1, 3/2/2015 (Table B)
Person 1, 3/5/2015 (Table A) -> Person 1, 3/5/2015 (Table B)
Person 1, 3/6/2015 (Table A) -> Person 1, 3/6/2015 (Table B)
For the moment I loop through "No." column in Table A and use Application.VLookup on Table B but that only works when a Person has only one date. Otherwise it compares to the first date from Table B. See code:
For sheetArowCounter= 2 To sheetAlastRow
Sheets("A").Select
sheetAperson = Cells(sheetArowCounter, 1)
sheetAdate = Cells(sheetArowCounter, 2)
Sheets("B").Select
sheetBdate = Application.VLookup(sheetAperson, _
Sheets("B").Range(Cells(1, 1), Cells(sheetBLastRow, 2)), 2, False)
If IsError(sheetBdate ) Then
personFromTableAnotFound = personFromTableAnotFound + 1
ElseIf sheetBdate <> sheetAdate Then
sheetAdateNotMatched = sheetAdateNotMatched + 1
End If
sheetAdateCompared = sheetAdateCompared + 1
Next sheetArowCounter
Any idea how can I do that?

I agreed with Jeeped above. Try using a SUMIF. You can even nest the SUMIF in an IF statement to return text: ie: "Match", "No match"

I'd go for a countifs function which can test for criteria against multiple columns. Here is an example for how you could implement this in your code:
For sheetArowCounter = 2 To sheetAlastRow
Sheets("A").Select
sheetAperson = Cells(sheetArowCounter, 1)
sheetAdate = Cells(sheetArowCounter, 2)
Sheets("B").Select
'using the countifs function eg. =COUNTIFS(B!A3:A11,A!A3,B!B3:B11,A!B3)
PersonDateMatches = Application.WorksheetFunction.CountIfs(Sheets("B").Range(Cells(1, 1), Cells(sheetBLastRow, 1)), sheetAperson, Sheets("B").Range(Cells(1, 2), Cells(sheetBLastRow, 2)), sheetAdate)
If PersonDateMatches = 0 Then
personDateFromTableAnotFound = personDateFromTableAnotFound + 1
End If
sheetAdateCompared = sheetAdateCompared + 1
Next sheetArowCounter

Related

VLookup analogue in VBA, printing two columns based on StrComp with common first column

I'm updating a VBA script and trying to match a 4-digit code with a table and printing the two corresponding columns into my original sheet, plus handling codes missing from the reference table.
jobcodes = sample codes to match.
codematch = reference table, 1st column is reference codes, I want the corresponding values in columns 2 and 3 in K and L of "jobcodes".
At the minute I'm getting blank values in the first two rows, then #N/A errors in the rest of the sample table.
finrow3 = jobs.Cells(Rows.Count, 1).End(xlUp).Row
jobcodes = jobs.Range(("J2"), ("L" & finrow3)).Value
codematch = stat.Range("I2:K143").Value
For i = 1 To finrow3 - 1
For j = 1 To UBound(codematch, 1)
If StrComp(jobcodes(i, 1), codematch(j, 1)) = 0 Then
resulta(z, 1) = codematch(j, 2)
resulta(z, 2) = codematch(j, 3)
Else
resulta(z, 1) = ""
resulta(z, 2) = ""
End If
Next j
Next i
jobs.Range(("K2"), ("L" & finrow3)).Value = Application.Transpose(resulta)

Generating array of all possible combinations from array regardless of number of elements in VBA

I need to take an input of mins and maxes for multiple variables and generate an array containing each possible combination.
Example: Entering the array
[A min, A max
B min, B max]
should return
[A min, B min
A min, B max
A max, B min
A max, B max]
I was able to do this but only with under 3 variables but can't conveniently expand it. I can't figure out how to make it work for any amount of variables, like if there was a C that also has a max and min.
Does anyone have suggestions?
edit:
If this helps anyone, purpose of this function is to find the extremes of a variable based expression. The first array is generated from the variables included in the expression, then the variables are replaced with values from the second array. So essentially every is calculated to find the highest possible outcome and lowest possible outcome.
So an input that created the first array could have been something like: 'A+B'
Then, for each row in the second array, 'A' and 'B' would be substituted with the instructed value.
Here is a VBA function which can be used to solve one interpretation of your problem:
Function Products(A As Variant) As Variant
'A is assumed to be a 2-column 1-based array
'The function returns another 2-column 1-based array
'Where each successive 4 rows gives the Cartesian product
'of two of the rows of A, with the earlier row
'providing the first element and the latter row the second
Dim i As Long, j As Long, k As Long, n As Long
Dim P As Variant
n = UBound(A, 1)
ReDim P(1 To 2 * n * (n - 1), 1 To 2)
k = 1
For i = 1 To n - 1
For j = i + 1 To n
P(k, 1) = A(i, 1)
P(k, 2) = A(j, 1)
P(k + 1, 1) = A(i, 1)
P(k + 1, 2) = A(j, 2)
P(k + 2, 1) = A(i, 2)
P(k + 2, 2) = A(j, 1)
P(k + 3, 1) = A(i, 2)
P(k + 3, 2) = A(j, 2)
k = k + 4
Next j
Next i
Products = P
End Function
Used like: Range("C1:D12").Value = Products(Range("A1:B3").Value)

look through array assign values into 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

INDEX MATCH array formula for 1M rows

I have two sets of data that need to be matched based on IDs and timestamp (+/- 3 units converted from time), and below is the formula that I've been using in Excel to do the matching. Recently I've had to run this formula on up to 1 million rows in Excel, and it takes a REALLY long time, crashes too. I'm wondering if there is a faster way to do this, if not in Excel?
=INDEX(A:A,MATCH(1,--(B:B=E3)*--(ABS(C:C-F3)<=3),0),1)
Data Set 1:
Column A: States
Column B: IDs
Column C: Timestamp
Data Set 2:
Column D: Email Addresses
Column E: IDs
Column F: Timestamp
Column G: =INDEX(A:A,MATCH(1,--(B:B=E3)*--(ABS(C:C-F3)<=3),0),1)
Goal: Append "States" Column to Data Set 2 matched on IDs and Timestamp (+/- 3 time units) match.
Just don't know how to run this formula on very large data sets.
Place the following VBA routines in a standard code module.
Run the MIAB1290() routine.
This emulates the precise outcome of your INDEX/MATCH formula, but it is much more efficient. On my computer, a million records are correctly correlated and the results displayed in Column G in just 10 seconds.
Public Sub MIAB1290()
Dim lastB&, k&, e, f, z, v, w, vErr, r As Range
With [a2]
Set r = .Resize(.Item(.Parent.Rows.Count - .Row + 1, 5).End(xlUp).Row - .Row + 1, .Item(, .Parent.Columns.Count - .Column + 1).End(xlToLeft).Column - .Column + 1)
lastB = .Item(.Parent.Rows.Count - .Row + 1, 2).End(xlUp).Row - .Row + 1
End With
With r
.Worksheet.Sort.SortFields.Clear
.Sort Key1:=.Item(1, 2), Order1:=1, Key2:=.Item(1, 2), Order2:=1, Header:=xlYes
v = .Value2
End With
ReDim w(1 To UBound(v), 1 To 1)
vErr = CVErr(xlErrNA)
For k = 2 To UBound(v)
e = v(k, 5)
f = v(k, 6)
w(k, 1) = vErr
z = BSearch(v, 2, e, 1, lastB)
If z Then
Do While v(z, 2) = e
If Abs(v(z, 3) - f) <= 3 Then
w(k, 1) = v(z, 1)
Exit Do
End If
z = z + 1
If z > UBound(v) Then Exit Do
Loop
End If
Next
r(1, 8).Resize(r.Rows.Count) = w
End Sub
Private Function BSearch(vA, col&, vVal, ByVal first&, ByVal last&)
Dim k&, middle&
While last >= first
middle = (last + first) / 2
Select Case True
Case vVal < vA(middle, col)
last = middle - 1
Case vVal > vA(middle, col)
first = middle + 1
Case Else
k = middle - 1
Do While vA(k, col) = vA(middle, col)
k = k - 1
If k > last Then Exit Do
Loop
BSearch = k + 1
Exit Function
End Select
Wend
BSearch = 0
End Function
Excel isn't really made for large ammount of data, and probably no code will do it faster for you then a builtin excel formula. In this case, I would sugest you to give a try to the PowerPivot addin, and see how it handles the situation.

Using VBA/Macro in Excel to reformat report. Moving records in single column, multiple row format to single row, multiple columns format

I am working with a system that reports user data into two columns: Column A has the fields (9 total per record) and Column B has the corresponding user data.
Column A looks like this:
Last Name:
First Name:
Middle Name:
Card Number:
Employee Ref:
Personal Details:
Associate Number:
Location Name:
Status:
The formatting on this report has the fields repeated for each record, meaning that row 10 will be blank, and row 11 will be Last Name:, row 12 will be First Name:, etc. This format results in very lengthy reports that are difficult to manage.
Another complication to this report concerns null values. Fields with null values are excluded from the report. For example, a record that does not have a Location Name will exclude the Location Name: field altogether. The result of the missing field is a record that is 8 rows instead of the the normal 9 rows. Some of these records are missing multiple fields, on account of null values.
I am looking for an elegant way to reformat this report. Specifically, I'm looking for...
-The fields in Column A become Column headers (A,B,C,D,E,F,G,H,I).
-The data in Column B is moved onto a single row, aligned with the corresponding field headers.
The report I'm currently looking at has 3730 records. However, the system outputs a file that is 43906 rows (including blank rows). I'd like to get this report to 3731 rows (1 row for field headers + 3730 records).
Any assistance with reformatting this report would be greatly appreciated.
Thank you,
pheidias
Here is some sample data of 3 records:
• Last Name: #1
• First Name: Security
• Middle Name: Badge
• Card Number: 100
• Employee Ref: Security
• Personal Details: none
• Associate Number: N/A
• Location Name: HQ
• Status: Contractor / Temp
•
• Last Name: Doe
• First Name: John
• Middle Name:
• Card Number: 101
• Employee Ref:
•
• Last Name: Deere
• First Name: John
• Middle Name:
• Card Number: 102
• Employee Ref:
• Status: Associate
Try this.
Place the following routine into a standard code module:
Sub pheidias()
Dim c&, i&, t, v, w
With ActiveSheet.[a1]
v = .Resize(.Item(.Parent.Rows.Count).End(xlUp).Row, 2)
End With
ReDim w(1 To UBound(v), 1 To 9)
t = Split(".Last Name.First Name.Middle Name.Card Number.Employee Ref.Personal Details.Associate Number.Location Name.Status.", ".")
For i = 1 To 9
w(1, i) = t(i)
Next
c = 2
For i = 1 To UBound(v)
If Len(v(i, 1)) Then
w(c, (InStr("lafimicaempeaslost", LCase$(Left$(v(i, 1), 2))) - 1) / 2 + 1) = v(i, 2)
Else
c = c + 1
End If
Next
[e1].Resize(UBound(w), UBound(w, 2)) = w
End Sub
Note: this routine assumes that the data start in cell A1 and that only ONE blank row separates each of the source report groups.
Note: the location of the output can be edited in the last line. The upper left-hand corner of the output report currently defaults to cell E1.
UPDATE
Try this also. The two versions are really the same, but the one below is probably easier to read...
Sub pheidias()
Dim c&, i&, v, w
With ActiveSheet.[a1]
v = .Resize(.Item(.Parent.Rows.Count).End(xlUp).Row, 2)
End With
ReDim w(1 To UBound(v), 1 To 9)
w(1, 1) = "Last Name"
w(1, 2) = "First Name"
w(1, 3) = "Middle Name"
w(1, 4) = "Card Number"
w(1, 5) = "Employee Ref"
w(1, 6) = "Personal Details"
w(1, 7) = "Associate Number"
w(1, 8) = "Location Name"
w(1, 9) = "Status"
c = 2
For i = 1 To UBound(v)
If Len(v(i, 1)) Then
Select Case LCase$(Left$(v(i, 1), 2))
Case "la": w(c, 1) = v(i, 2)
Case "fi": w(c, 2) = v(i, 2)
Case "mi": w(c, 3) = v(i, 2)
Case "ca": w(c, 4) = v(i, 2)
Case "em": w(c, 5) = v(i, 2)
Case "pe": w(c, 6) = v(i, 2)
Case "as": w(c, 7) = v(i, 2)
Case "lo": w(c, 8) = v(i, 2)
Case "st": w(c, 9) = v(i, 2)
End Select
Else
c = c + 1
End If
Next
[e1].Resize(UBound(w), UBound(w, 2)) = w
End Sub