Vba code to pull content from one sheet to another

shina67

Board Regular
Joined
Sep 18, 2014
Messages
141
Hi All,

I have a couple of reports I download on a daily basis.

One report is the employees name and badge number.
The other report is employees absenteeism.

The problem I have is the following:-

The 'Employee Absences' report does not show the employees full name.
The 'Employee List' does show the employees full name.

I need the sheet 'Employee Absences' to pull in the employees full name from the 'Employee List' sheet.

I then need to create a pivot from this information so I can keep a track of employees absences.
I have attached a copy of the workbook.
The sheets within the workbook are exactly as the reports download. When you look at the reports you will understand more why I an struggling.

I would copy/paste the downloaded reports directly into the 'Employee Absences' and 'Employee List' sheets daily. Hopefully then run some code to give me the above.

Any help would be greatly appreciated.
The below are in one workbook.

Employee List & Absences.xlsx
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAKAL
1
2Employee Absences
3Wed 21 September 2022
4
5
6
7BadgeNameCompanyDepartmentGroupDateAbsence CodeTime Taken
8
9
10
1100006GEOFFREYExpress Bi folding DoorsProductionFabricationMon07/03/2022SIKUP0:00
12
13Tue08/03/2022SIKUP0:00
14
15
16Wed09/03/2022SIKUP0:00
17
18Thu10/03/2022SIKUP0:00
19
20
21
22
23Absences with deduct value equal to 0 :0Absences with deduct value equal to 1/4 day :0
24
25Absences with deduct value equal to 1/2 day :0Absences with deduct value equal to a full day :4
26
27Absences with deduct value equal to 3/4 day :0
28
29
30
31Total absence records :4Total number of unauthorised absences :0Total time in absence :0:00
32
33
34
35
36
37BadgeNameCompanyDepartmentGroupDateAbsence CodeTime Taken
38
39
40
4100113MassinghamExpress Bi folding DoorsProductionMachiningFri01/04/2022SIKUP0:00
42
43Wed13/07/2022SIKUP0:00
44
45
46Thu14/07/2022SIKUP0:00
47
48Fri15/07/2022SIKUP0:00
Employee Absences


Employee List & Absences.xlsx
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAKALAMANAOAPAQARASATAUAVAWAXAYAZBABBBCBDBEBFBGBHBIBJBKBLBMBNBOBPBQBRBSBTBUBVBWBXBYBZCACBCCCDCECFCGCHCICJCKCLCMCNCOCPCQCRCSCTCUCVCWCXCYCZDADB
1
2Employee List & Payroll Number
3Wed 21 September 2022
4
5BadgeNamePayroll No.
6
700006GEOFFREY NEIL GREENWOOD6
8
9
10
1100042ROBERT MOUNTAIN42
12
13
14
1500113JOHN DAVID MASSINGHAM113
16
Employee List
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
I tried to give you what was requested. Code loops through column E looking for "short" names. If found, the sub uses Function FindStringInSheet to find the full name in the other worksheet. That full name is put into the cell with the short name.

VBA Code:
Function FindStringInSheet(pwsSheet As Worksheet, psFindString As String, Optional ByRef prCell)
    
    Dim rCellFound As Range
    
    Set rCellFound = Nothing
    
    FindStringInSheet = ""
    
'   Find may look for "part" (xlPart) or whole (xlWhole)
    On Error Resume Next
    Set rCellFound = pwsSheet.Cells.Find( _
        What:=psFindString, LookAt:=xlPart, SearchOrder:=xlByRows)
    On Error GoTo 0
    
    If Not rCellFound Is Nothing _
     Then
        If Not IsMissing(prCell) Then Set prCell = rCellFound
        FindStringInSheet = rCellFound.Address
    End If
    
End Function


VBA Code:
Sub GetFullNames()

'   Last occupied row in the column containing names.
    Dim iLastRow As Long
    
'   Column # in which short names are located.
    Dim iColNumber As Long
    
'   Range to search looking for short names.
    Dim rSearchRange As Range

'   Used to loop through rSearchRange
    Dim rCell As Range
    
'   Short name found.
    Dim sShortName As String
    
'   Cell containing long name if found.
    Dim rFoundCell As Range
    
'   Workbook where full names are needed
    Dim wsTarget As Worksheet
    
'   Workbook where full names are located
    Dim wsSource As Worksheet
    
    Set wsTarget = ThisWorkbook.Worksheets("Sheet1")
    Set wsSource = ThisWorkbook.Worksheets("Sheet2")
    
'   Assume name data is in column E (i.e., 5). Otherwise reset this value.
    iColNumber = 5
    
    With wsTarget
    
        iLastRow = .Cells(1, iColNumber).Offset(100000).End(xlUp).Row
    
        Set rSearchRange = .Range(.Cells(1, iColNumber), .Cells(iLastRow, iColNumber))
    
        For Each rCell In rSearchRange
        
            If rCell.Value <> "" And UCase(rCell.Value) <> "NAME" _
             Then
                sShortName = UCase(rCell.Value)
                
                Call FindStringInSheet(wsSource, sShortName, rFoundCell)
                
                If Not rFoundCell Is Nothing _
                 Then
                    rCell.Value = rFoundCell.Value
                End If
            
            End If
        
        Next rCell
    
    End With 'wsTarget

End Sub
 
Upvote 0

Forum statistics

Threads
1,223,248
Messages
6,171,027
Members
452,374
Latest member
keccles

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top