Need VBA code to match the value and split the data in the multiple sheets based on column

Hello Team,

I am having the spread sheet where I have more than 70000 rows data with 25 columns in sheet1 and 6 columns and 60 rows in the sheet2, I need a code with the below options.

1. In sheet1 insert one column (A column) and update the heading as Employee name.
2. match the names from the column name "Invalid" from the sheet 1 and look up it in sheet 2 under the column name "Invalid Employee", then update the "Actual Employee Name" from sheet2 to sheet1 under column A which is named as Employee name.
3. Filter the data in column A named "Employee name" and split the data in to multiple sheets (data needs to copy from B column to end of the column) and rename the sheets with the value given in the A column named "Employee name".
4. In each sheet I need the total count under the Task 11 and auto sum in all the column names (Task 12, Task 13, Task 14) and result should be in bold letters.

Note - Data needs to lookup/Match up based on the column name and not as per the column number, since some times the column will be interchange in the portal.

I tried with the other codes given in other forums but I am getting some virtual memory error, not sure if this error occurs because I have more data but kindly help me to get the correct code which should not gives me any error while executing.

Kindly do the needful at the earliest possible. I have attached both the data. Thank you.

Maybe:

Please Login or Register  to view this content.

Thank you very much, the code is working fine.....

@ bakerman2. Thanks - copying and pasting can get you into trouble sometimes.

Hello bakerman/John,

When I tried the given code to my actual sheet its not working, I am used code given below and also attached actual spread sheet. Please assist me if I am doing anything wrong. Thank you.

Sub tst()

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
With Sheets("Sheet1")
.Columns(1).Insert
.Cells(1).Value = "Employee Name"
InvEmpName = Application.Match("Analysis Code", .Rows(1), 0)
InvEmpName2 = Application.Match("Analysis Code", Sheets("Sheet2").Rows(1), 0)
ActEmpName = Application.Match("TYPE", Sheets("Sheet2").Rows(1), 0)
sn = .Cells(1).CurrentRegion.Value
Set dic = CreateObject("scripting.dictionary")
For i = 2 To UBound(sn)
sn(i, 1) = Sheets("Sheet2").Cells(Application.Match(sn(i, InvEmpName), Sheets("Sheet2").Columns(InvEmpName2), 0), ActEmpName)
x0 = dic.Item(sn(i, 1))
Next
.Cells(1).Resize(UBound(sn), UBound(sn, 2)) = sn
End With
For j = 0 To dic.Count - 1
Sheets.Add , Sheets(Sheets.Count)
With Sheets("Sheet1")
.Cells(1).CurrentRegion.AutoFilter 1, dic.keys()(j)
.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy Sheets(Sheets.Count).Range("A1")
End With
With Sheets(Sheets.Count)
.Columns(1).Delete
.Name = dic.keys()(j)
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
.Cells(lr + 1, 19).Formula = "=COUNTA(S2:S" & lr & ")"
.Cells(lr + 1, 20).Formula = "=SUM(T2:T" & lr & ")"
.Cells(lr + 1, 21).Formula = "=SUM(U2:U" & lr & ")"
.Cells(lr + 1, 22).Formula = "=SUM(V2:V" & lr & ")"
.Cells(lr + 1, 23).Formula = "=SUM(W2:W" & lr & ")"
.Cells(lr + 1, 19).Resize(, 4).Font.Bold = True
End With
Next
Sheets("Sheet1").AutoFilterMode = False
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

Thank you very much for all your help, really its working fine for me.