Macro Help Please

M

mattyn

New member
Joined
Apr 24, 2015
Messages
4
Reaction score
0
Points
0
Hi All

Attached is a test workbook for my real life book I am trying to build.

Sheet 1 is a team of employees by Title, Name and their allocated Team. This list in reality is over 100 employees long! In addition, there is a time sheet that shows there whereabouts by each day, with differing colours for differing places they may be.

I want to pull that data to form the Team Sheets on the other worksheet.

I have made a Macro that basically filters the list by teams, and copies to the second sheet. However this Macro fails.

Macro is as such:
========================================
Code: 
Sub Macro3()
'
' Macro3 Macro
'


'
    ActiveSheet.Range("$A$3:$AF$9").AutoFilter Field:=3, Criteria1:="Team1"
    Range("A:B,E:K").Select
    Range("E1").Activate
    Selection.Copy
    Sheets("Sheet5").Select
    ActiveSheet.Paste
    Range("J1").Select
    Sheets("Sheet1").Select
    ActiveSheet.Range("$A$3:$AF$9").AutoFilter Field:=3, Criteria1:="Team2"
    Range("A:B,E:K").Select
    Range("E1").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet5").Select
    ActiveSheet.Paste
    Range("S1").Select
    Sheets("Sheet1").Select
    ActiveSheet.Range("$A$3:$AF$9").AutoFilter Field:=3, Criteria1:="Team3"
    Range("A:B,E:K").Select
    Range("E1").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet5").Select
    ActiveSheet.Paste
    Range("P17").Select
    Sheets("Sheet1").Select
    ActiveSheet.Range("$A$3:$AF$9").AutoFilter Field:=3
End Sub
============================================

Can anyone help? I think it might be possible with either separate Macros for each team, of HLookup or VLookup, but I am a little lost on these.

Many thanks in advance

Matt
 

Attachments

  • Test Workbook3.xlsm
    17.9 KB · Views: 24
Last edited by a moderator:
Code: 
Sub Macro3()Dim gantt As Worksheet
Dim schedule As Worksheet
Dim ganttData As Range
Dim lastrow As Long


    With ActiveWorkbook
    
        Set gantt = .Worksheets("Sheet1")
        Set schedule = .Worksheets("Sheet3")
        
        With gantt
        
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            Set ganttData = .Range("$A$3:$AF$3").Resize(lastrow - 2)
            GetTeamData ganttData, schedule, "Team1"
            GetTeamData ganttData, schedule, "Team2"
            GetTeamData ganttData, schedule, "Team3"
            ganttData.AutoFilter Field:=3
        End With
    End With
End Sub




Private Function GetTeamData(ByRef Source As Range, ByRef target As Worksheet, ByVal Team As String)
Dim data As Range
Dim dataArea As Range
Dim matchRow As Long


    With target
    
        matchRow = Application.Match(Team, .Columns("A"), 0)
    
        Source.AutoFilter Field:=3, Criteria1:=Team
        Set data = Source.Offset(1, 0).Resize(Source.Rows.Count - 1)
        Set data = data.SpecialCells(xlCellTypeVisible)
        For Each dataArea In data.Areas
        
            dataArea.Resize(, 2).Copy target.Cells(matchRow, "B")
            dataArea.Offset(0, 4).Resize(, 7).Copy target.Cells(matchRow, "D")
            matchRow = matchRow + dataArea.Rows.Count
        Next dataArea
    End With
End Function
 
Thank you for helping. It is much appreciated - however it gives me an error. I suspect I am entering it incorrectly but I get an error saying

"Compile Error - Expected End Of Statement".

I opened the workbook, right click the tab Sheet 1, and clicked View Code. I then clicked on Insert Modulw, and pasted your code in. Saved, then ran the Macro and got the error.

Any ideas?
 
The code has been messed up by the forum formatter.

Where it says

Code: 
Sub Macro3()Dim gantt As Worksheet

change it to separate lines

Code: 
Sub Macro3()
Dim gantt As Worksheet
 
You must log in or register to reply here.
Back
Top