Condensing Data using an Array?

[VBABeginner1]

Hi I am creating an Employee Database that tracks reports on employees. Basically if an employee has an absence I want to copy the employee name and information and move it to their personal file. I have created this workbook with lots of recorded marco's. So if the employee name is "Barl, Diane" then it copy's the information to Sheet("Barl, Diane") But when I look through all my code, I have the name "Barl, Diane" used 60+ times in different modules and such. I am looking for how to define an array of Employees so that I can put all 100+ employees into an area then be able to condense and simplify the code I have currently the code below works, but whenever I have tried and Array (assuming that what I need) it doesn't work. I have tried so many array videos and threads that I am beyond confused to what the code is supposed to look like in the end. So I am leaving the code that works and hoping that someone can show me how to properly assign multiple employees to an array that I can call upon them throughout the workbook


Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("ShiftReport")

If ws.Range("d1").End(xlDown).Value = AttendanceList.Text = True And ws.Range("g1").End(xlDown).Value = "Barl, Diane" Or ws.Range("h1").End(xlDown).Value = "Barl, Diane" Or ws.Range("i1").End(xlDown).Value = "Barl, Diane" Then

' EmpFileAttend Macro
' Below is the recorded macro that follows, just a small example of what the above code goes into and what I am looking for
Sheets("ShiftReport").Select
Range("A1").Select
Selection.End(xlDown).Select
Selection.Copy
Sheets("Barl, Diane").Select
Range("G3").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Sheets("ShiftReport").Select
Range("C1").Select
Selection.End(xlDown).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Barl, Diane").Select
Range("H3").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Sheets("ShiftReport").Select
Range("D1").Select
Selection.End(xlDown).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Barl, Diane").Select
Range("I3").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Sheets("ShiftReport").Select
ActiveWindow.SmallScroll ToRight:=2
Range("L1").Select
Selection.End(xlDown).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Barl, Diane").Select
Range("J3").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Sheets("ShiftReport").Select
Range("F1").Select
Selection.End(xlDown).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Barl, Diane").Select
Range("K3").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste

 

[Blade Hunter]

OK Working with Arrays can be a little confusing in the begining.

This will populate your array with the list of employees from a sheet:

Dim EmployeeArray as variant
EmployeeArray = application.transpose(Range("A1:A3")) '<-- Change this range to your range

This is how you do it in code if you dont have a list in Excel:

Dim EmployeeArray as variant
EmployeeArray = Array("Person Name 1","Person Name 2","Another person name")

To reference a value in an array you use braces like so: EmployeeArray(2) depending on your option base this will bring back the 2nd or 3rd value in the array.

You can loop through an array like so:

Dim EmployeeArray as variant, X as long
EmployeeArray = application.transpose(Range("A1:A3")) '<-- Change this range to your range
For X = lbound(EmployeeArray) to ubound(EmployeeArray) '<-- This loops from the lower boundary to the upper boundary
    'Do Something Here using EmployeeArray(X) to get the current loops value in the array
Next

Last but no least, whenever you record a macro, the first thing you should do to it is remove the selects. ALL the code you posted above can be condensed when you remove the selects, it will also speed it up massively, if you are planning on looping this through employees, the benefit will be massive:

Sheets("ShiftReport").Range("A1").End(xlDown).Copy
Sheets("Barl, Diane").Range("G3").End(xlDown).Range("A1").Paste
Sheets("ShiftReport").Range("C1").End(xlDown).Copy
Sheets("Barl, Diane").Range("H3").End(xlDown).Offset(1, 0).Range("A1").Paste '<-- You can probably remove the Range("A1"). from each of these lines
Sheets("ShiftReport").Range("D1").End(xlDown).Copy
Sheets("Barl, Diane").Range("I3").End(xlDown).Offset(1, 0).Range("A1").Paste
Sheets("ShiftReport").Range("L1").End(xlDown).Copy
Sheets("Barl, Diane").Range("J3").End(xlDown).Offset(1, 0).Range("A1").Paste
Sheets("ShiftReport").Range("F1").End(xlDown).Copy
Sheets("Barl, Diane").Range("K3").End(xlDown).Offset(1, 0).Range("A1").Paste

Hope that helps, post back if you get stuck.

Cheers

Dan

 

[VBABeginner1]

Thanks for responding, this was is different then I could find in most places with using a Named Range, this hopefully will make it work easier.

I am stuck with this part below:

For X = lbound(EmployeeArray) to ubound(EmployeeArray) '<-- This loops from the lower boundary to the upper boundary
'Do Something Here using EmployeeArray(X) to get the current loops value in the array


Is this where I would put
EmployeeArray(x) = "Barl, Diane"; "Gent, Matt" 'etc
or is it
EmployeeArray1= "Barl, Diane"
EmployeeArray2= "Gent, Matt"
'etc.

Thanks for the comments on cleaning up the recorded Macro, I remembered that there was something I was supposed to delete after I was done recording but was going to look into it once everything began to flow.

Thanks

 

[My Aswer Is This]

That is a great explanation Blade Hunter.

 

[Blade Hunter]

You would do that with this example:


EmployeeArray = Array("Person Name 1","Person Name 2","Another person name")</pre>
in the for loop you would use EmployeeArray(X) to retrieve each element

example run this:

Sub EmployeeTemp()
Dim EmployeeArray As Variant, X As Long
EmployeeArray = Array("Person Name 1", "Person Name 2", "Another person name")
For X = LBound(EmployeeArray) To UBound(EmployeeArray) '<-- This loops from the lower boundary to the upper boundary
    MsgBox EmployeeArray(X)
Next
End Sub

 

[Blade Hunter]

That is a great explanation Blade Hunter.

Thanks for the feedback, glad you liked it

 

[VBABeginner1]

I have tweaked and adjusted the section of code below so much and I still can't get it to run properly now that I have introduced the array to it. I am currently getting a "Run time error 13- type mismatch on the line below that is in RED.


Dim EmpDrop1, EmpDrop2, EmpDrop3 As String
Dim AttendList As String
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("ShiftReport")
EmpDrop1 = ws.Range("g1").End(xlDown).Value
EmpDrop2 = ws.Range("h1").End(xlDown).Value
EmpDrop3 = ws.Range("i1").End(xlDown).Value
AttendList = ws.Range("d1").End(xlDown).Value = AttendanceList.Text
Dim EmpArray As Variant, X As Long
EmpArray = Application.Transpose(Range("EmployeeList"))

For X = LBound(EmpArray) To UBound(EmpArray) '<-- This loops from the lower boundary to the upper boundary
'Do Something Here using EmployeeArray(X) to get the current loops value in the array
Next
If AttendList = True And EmpDrop1 = EmpArray Or EmpDrop2 = EmpArray Or EmpDrop3 = EmpArray Then
'EmpFileAttend Macro
Sheets("ShiftReport").Range("A1").End(xlDown).Copy
Sheets(EmpArray(X)).Range("G3").End(xlDown).Range("A1").Paste
Sheets("ShiftReport").Range("C1").End(xlDown).Copy
Sheets(EmpArray(X)).Range("H3").End(xlDown).Offset(1, 0).Range("A1").Paste '<-- You can probably remove the Range("A1"). from each of these lines
Sheets("ShiftReport").Range("D1").End(xlDown).Copy
Sheets(EmpArray(X)).Range("I3").End(xlDown).Offset(1, 0).Range("A1").Paste
Sheets("ShiftReport").Range("L1").End(xlDown).Copy
Sheets(EmpArray(X)).Range("J3").End(xlDown).Offset(1, 0).Range("A1").Paste
Sheets("ShiftReport").Range("F1").End(xlDown).Copy
Sheets(EmpArray(X)).Range("K3").End(xlDown).Offset(1, 0).Range("A1").Paste

'' EmpFileAttend Macro
ActiveCell.Offset(0, -4).Range("A1:E1").Select
ActiveCell.Activate
Application.CutCopyMode = False
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
Call boxthem

End With
ElseIf AttendList = False And EmpDrop1 = EmpArray Or EmpDrop2 = EmpArray Or EmpDrop3 = EmpArray Then
Range("A1").End(xlDown).Range("A1:F1").Copy
Sheets(EmpArray).Range("A1").End(xlDown).Offset(1, 0).Range("A1").Paste
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
Call boxthem
End With
End If