Help with Loops

[mykal66]

Hi again folks - 2 posts in one day but not real urgency on this as what i have works but i know it really dirty coding because i don't know how to use loops.

I created a absence tracker for work which in short summaries various absences form work (e.g. Sickness, Annual Leave, Training etc) onto a hidden worksheet for everyone.

The mess i use below allows a manager to select a user name then copy data for that user only onto another table and create a stacked column chart showing everything for that person.

I understand the concept of looping but never really figured out how to do it but this time i copied the same things so many times i finally got an 'project to large' message in vba (which i also didn't know about). As you can see the code is exactly the same apart from the name changes but i have a named list which i assume the loop would use and the copy values drop down 1 row for each person so essentially all i did was copy and paste, change the look up name then manually altered the 26 refs to each row.

As i said this is just a learning curve for me as this works but i would like to become a better amateur


Sub Button3_Click()
Dim Staff As String
Staff = Range("D2").Value
If Staff = ("Someone Smith") Then
Application.ScreenUpdating = False


Sheets("Summary").Select
Range("B4:C4").Select
Selection.Copy
Sheets("Admin").Select
Range("E5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Summary").Select
Range("E3:F3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Admin").Select
Range("E6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Summary").Select
Range("H3:I3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Admin").Select
Range("E7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Summary").Select
Range("K3:L3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Admin").Select
Range("E8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Summary").Select
ActiveWindow.SmallScroll ToRight:=10
Range("N3:O3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Admin").Select
Range("E9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Summary").Select
Range("Q3:R3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Admin").Select
Range("E10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Summary").Select
Range("T3:U3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Admin").Select
Range("E11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Summary").Select
Range("W3:X3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Admin").Select
Range("E12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Summary").Select
ActiveWindow.SmallScroll ToRight:=9
Range("Z3:AA3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Admin").Select
Range("E13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Summary").Select
Range("AC3:AD3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Admin").Select
Range("E14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Summary").Select
Range("AF3:AG3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Admin").Select
Range("E15").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Summary").Select
Range("AI3:AJ3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Admin").Select
Range("E16").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If





If Staff = ("Someone Jones") Then
Application.ScreenUpdating = False


Sheets("Summary").Select
Range("B4:C4").Select
Selection.Copy
Sheets("Admin").Select
Range("E5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Summary").Select
Range("E4:F4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Admin").Select
Range("E6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Summary").Select
Range("H4:I4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Admin").Select
Range("E7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Summary").Select
Range("K4:L4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Admin").Select
Range("E8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Summary").Select
ActiveWindow.SmallScroll ToRight:=10
Range("N4:O4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Admin").Select
Range("E9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Summary").Select
Range("Q4:R4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Admin").Select
Range("E10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Summary").Select
Range("T4:U4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Admin").Select
Range("E11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Summary").Select
Range("W4:X4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Admin").Select
Range("E12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Summary").Select
ActiveWindow.SmallScroll ToRight:=9
Range("Z4:AA4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Admin").Select
Range("E13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Summary").Select
Range("AC4:AD4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Admin").Select
Range("E14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Summary").Select
Range("AF4:AG4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Admin").Select
Range("E15").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Summary").Select
Range("AI4:AJ4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Admin").Select
Range("E16").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If


Thanks again

[Bob Phillips]

Sub Button3_Click()
Dim Staff As String
Dim startrow As Long

Staff = Range("D2").Value
Select Case Staff

Case "Someone Smith": startrow = 3

Case "Someone Jones": startrow = 4

'etc.
End Select

If startrow > 0 Then

Application.ScreenUpdating = False

Sheets("Summary").Cells(startrow, "B").Resize(, 2).Copy
Sheets("Admin").Range("E5").PasteSpecial Paste:=xlPasteValues
Sheets("Summary").Cells(startrow, "E").Resize(, 2).Copy
Sheets("Admin").Range("E6").PasteSpecial Paste:=xlPasteValues
Sheets("Summary").Cells(startrow, "H").Resize(, 2).Copy
Sheets("Admin").Range("E7").PasteSpecial Paste:=xlPasteValues
Sheets("Summary").Cells(startrow, "K").Resize(, 2).Copy
Sheets("Admin").Range("E8").PasteSpecial Paste:=xlPasteValues
Sheets("Summary").Cells(startrow, "N").Resize(, 2).Copy
Sheets("Admin").Range("E9").PasteSpecial Paste:=xlPasteValues
Sheets("Summary").Cells(startrow, "Q").Resize(, 2).Copy
Sheets("Admin").Range("E10").PasteSpecial Paste:=xlPasteValues
Sheets("Summary").Cells(startrow, "T").Resize(, 2).Copy
Sheets("Admin").Range("E11").PasteSpecial Paste:=xlPasteValues
Sheets("Summary").Cells(startrow, "W").Resize(, 2).Copy
Sheets("Admin").Range("E12").PasteSpecial Paste:=xlPasteValues
Sheets("Summary").Cells(startrow, "Z").Resize(, 2).Copy
Sheets("Admin").Range("E13").PasteSpecial Paste:=xlPasteValues
Sheets("Summary").Cells(startrow, "AC").Resize(, 2).Copy
Sheets("Admin").Range("E14").PasteSpecial Paste:=xlPasteValues
Sheets("Summary").Cells(startrow, "AF").Resize(, 2).Copy
Sheets("Admin").Range("E15").PasteSpecial Paste:=xlPasteValues
Sheets("Summary").Cells(startrow, "AI").Resize(, 2).Copy
Sheets("Admin").Range("E16").PasteSpecial Paste:=xlPasteValues
End If
End Sub

[mykal66]

Xld - thank you isn't even close to how much i appreciate this - it's absolutely amazing and hammered home how much extra work i cause myself not knowing how to set this kind of thing up. I commented my code out (all 1600 lines for 17 staff!) and used yours for the first 2 colleagues and worked perfectly so i add everyone else when i go back to work!

Still figuring out the copy and paste part, but i can see how the case and start row works but going to play and work it out as don't like just using something without trying to understand.

Anyway thank you so much again - really really appreciated

Mykal

[SamT]

This code is built on XLD's fine work, but... It assumes that the dropdown list in D2 is from a list of staff names in column A of the Summary sheet. IOW, the absentee list is preceded with their names. You will have to adjust the Constant "StaffListColumn" to reflect the actual location.

This procedure will work for any number of staff without modification...That is, if it works at all. I haven't tested it and there may be a coding error in it.:devil2:


Option Explicit

Sub Button3_Click()

Const StaffListColumn = "A" 'Set this constant to the actual column on Summary that holds the list

Dim Staff As String

Dim Found As Range 'I always use "Found" with Find, so I can perform tests before proceeding

Dim StartRow As Long

Dim LastRow As Long 'the bottom row of the staff list

Dim CellsToCopy As Variant 'An Array holding the letters (Name) of the first column of each pair of Cells to copy over to the Admin sheet

Dim StaffList As Range 'This range will be used by the Find function to retrieve the StartRow

Dim i As Long

''''Assign Column Letters (Names) to Array
CellsToCopy = Array("B", "E", "H", "K", "Q", "T", "W", "Z", "AC", "AF", "AI")

''''Get Last row of Staff List and set StaffList Range
LastRow = Cells(Rows.Count, StaffListColumn).End(xlUp).Row
Set StaffList = Range(Cells(3, StaffListColumn), Cells(LastRow, StaffListColumn))


''''Find the Row of the selected Staff member
Staff = Range("D2").Value
Set Found = StaffList.Find(Staff)
If Found Is Nothing Then 'That member was not found
MsgBox "That Staff member is not in the List of Absentees"
Exit Sub
Else
StartRow = Found.Row
End If

Application.ScreenUpdating = False

''''Loop thru the Array of cells to be copied and paste them into Admin
For i = 0 To UBound(CellsToCopy)
Sheets("Summary").Cells(StartRow, CellsToCopy(i)).Resize(, 2).Copy
Sheets("Admin").Range("E" & CStr(i + 5)).PasteSpecial Paste:=xlPasteValues
Next i

Application.ScreenUpdating = True
End Sub

[mykal66]

Thank you SamT - I will try this one too as both your guys code make mine look like a novel and highlighted my need to learn better techniques rather than just muddle though.