I have four columns: Name, Code, Hired and Fired. The Value in the Code columns is unique. Someone can be hired and fired several times during the year, but I need only the first time that someone is hired and only the last time that someone is fired. Can I filter and update these columns using vba?
What I have are the values in columns from A to D. What I want are the values in columns from I to L.
So, if you are not aware of how to write VBA Code, then you may try using Excel Formulas as well, however for the following formulas, you definitely need to have access either to O365 or O365 Insiders Beta Version
• Formula used in cell F2 to get the Unique Name & Codes,
=UNIQUE(A2:B20)
• Formula used in cell H2
=MINIFS(C2:C20,A2:A20,F2:F6,B2:B20,G2:G6)
• Formula used in cell I2
=MAXIFS(D2:D20,A2:A20,F2:F6,B2:B20,G2:G6)
Using LET() makes easier to read and understand,
• Formula used in cell F9
=LET(u,UNIQUE(A2:A20),
c,UNIQUE(B2:B20),
CHOOSE({1,2,3,4},u,c,
MINIFS(C2:C20,A2:A20,u,B2:B20,c),
MAXIFS(D2:D20,A2:A20,u,B2:B20,c)))
Using LAMBDA() Function to create a custom, reusable function and refer them by a friendly name, LAMBDA() Function used in Name Manager with a Defined Name as HireFire with syntax as
=HireFire(array,header)
Where,
HireFire = LAMBDA(array,header,
VSTACK(TAKE(header,1,4),
LET(a,INDEX(array,,1),
b,INDEX(array,,2),
c,INDEX(array,,3),
d,INDEX(array,,4),
u,UNIQUE(a),
uc,UNIQUE(b),
HSTACK(u,uc,
MINIFS(c,a,u,b,uc),
MAXIFS(d,a,u,b,uc)))))(A2:D20,A1:D1)
• Therefore, Formula used in cell F15
=HireFire(A2:D20,A1:D1)
Since you have not mentioned your Excel Version, it may happen you are using either Excel 2019 or 2016 or 2013 so on so forth, hence, alternatives shown below,
• Formula used in cell F2
=IFERROR(INDEX(A$2:A$20,MATCH(0,COUNTIF($F$1:F1,A$2:A$20),0)),"")
The above formula, is an array formula and needs to press CTRL + SHIFT + ENTER based on your Excel Versions,
• Formula used in cell G2
=IF($F2="","",VLOOKUP($F2,$A$2:$D$20,2,0))
• Formula used in cell H2 --> Applicable To Excel 2019 & Above
=MINIFS(C$2:C$20,$A$2:$A$20,$F2,$B$2:$B$20,$G2)
If not using either of the above version then,
=MIN(IF(($F2=$A$2:$A$20)*($G2=$B$2:$B$20),$C$2:$C$20,""))
Its an array formula, hence needs to press CTRL + SHIFT + ENTER and fill down!
• Formula used in cell I2 --> Applicable To Excel 2019 & Above
=MAXIFS(D$2:D$20,$A$2:$A$20,$F2,$B$2:$B$20,$G2)
If not using either of the above version then,
=MAX(IF(($F2=$A$2:$A$20)*($G2=$B$2:$B$20),$D$2:$D$20,""))
Its an array formula, hence needs to press CTRL + SHIFT + ENTER and fill down!
If you have Office 365, you can do this with formulas as outlined in one of the other answers.
This can also be accomplished using Power Query, available in Windows Excel 2010+ and Excel 365 (Windows or Mac)
To use Power Query
Data => Get&Transform => from Table/Range or from within sheetHome => Advanced EditorApplied Steps to understand the algorithmM Code
let
//Read in data
// Change table name in next line to your actual table name
Source = Excel.CurrentWorkbook(){[Name="EmplTbl"]}[Content],
//Set the column data types
#"Changed Type" = Table.TransformColumnTypes(Source,{
{"NAME", type text}, {"CODE", type text}, {"HIRED", type date}, {"FIRED", type date}}),
//Group by Name and ID
// Then aggregate by minimum HIRED and maximum FIRED to get results
#"Grouped Rows" = Table.Group(#"Changed Type", {"CODE", "NAME"}, {
{"Hired", each List.Min([HIRED]), type nullable date},
{"Fired", each List.Max([FIRED]), type nullable date}
})
in
#"Grouped Rows"
Sub CreateHireFireReport()
Const sName As String = "Sheet1"
Const sFirstCellAddress As String = "A1"
Const uCol As Long = 2
Const hCol As Long = 3
Const fCol As Long = 4
Const dName As String = "Sheet1"
Const dFirstCellAddress As String = "I1"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim srg As Range: Set srg = sws.Range(sFirstCellAddress).CurrentRegion
If srg.Rows.Count < 2 Then Exit Sub ' no data or just headers
Dim srCount As Long: srCount = srg.Rows.Count
Dim cCount As Long: cCount = srg.Columns.Count
Dim sData As Variant: sData = srg.Value
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare
Dim Key As Variant
Dim sr As Long
For sr = 2 To srCount
Key = sData(sr, uCol)
If Not IsError(Key) Then
If Len(Key) > 0 Then
dict(Key) = Empty
End If
End If
Next sr
If dict.Count = 0 Then Exit Sub ' only blanks and error values
Dim drCount As Long: drCount = dict.Count + 1
Dim dData As Variant: ReDim dData(1 To drCount, 1 To cCount)
Dim ddr As Long: ddr = 1
Dim dr As Long
Dim c As Long
' Write headers.
For c = 1 To cCount
dData(1, c) = sData(1, c)
Next c
' Write data.
For sr = 2 To srCount
Key = sData(sr, uCol)
If Not IsError(Key) Then
If Len(Key) > 0 Then
If dict(Key) = Empty Then
ddr = ddr + 1
dr = ddr
dict(Key) = ddr
For c = 1 To cCount
dData(dr, c) = sData(sr, c)
Next c
Else
dr = dict(Key)
If IsDate(sData(sr, hCol)) Then
If IsDate(dData(dr, hCol)) Then
If sData(sr, hCol) < dData(dr, hCol) Then
dData(dr, hCol) = sData(sr, hCol)
End If
Else
dData(dr, hCol) = sData(sr, hCol)
End If
End If
If IsDate(sData(sr, fCol)) Then
If IsDate(dData(dr, fCol)) Then
If sData(sr, fCol) > dData(dr, fCol) Then
dData(dr, fCol) = sData(sr, fCol)
End If
Else
dData(dr, fCol) = sData(sr, fCol)
End If
End If
End If
End If
End If
Next sr
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
With dws.Range(dFirstCellAddress).Resize(, cCount)
' Format unique column as text.
.Resize(drCount, 1).Offset(, uCol - 1).NumberFormat = "@"
' Write result.
.Resize(drCount).Value = dData
' Clear below.
.Resize(dws.Rows.Count - .Row - drCount + 1).Offset(drCount).Clear
' Apply other formatting.
.Font.Bold = True ' headers
.EntireColumn.AutoFit
End With
MsgBox "Hire-fire-report created.", vbInformation
End Sub