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.

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.