Stuck on logic for Excel problem...

Question

Hi I am stuck on the logic for the following problem.

I have a list of employees and each has a manager attached.  I want to write a macro that will loop through all the employees on the sheet and compile a list of the managers with all employees reporting in to them.   I've attached an example as this may be hard to visualise!

http://i102.photobucket.com/albums/m82/sc0ttb_2006/Sheet1.jpg

http://i102.photobucket.com/albums/m82/sc0ttb_2006/Sheet2.jpg

I realise this will involve a for loop and then an IF statement or two and I know to use concatenate to add the names together into the one cell but I just can't get my head round the exact way to do it, so any help is greatly appreciated!

Many thanks

Answer 1

hello

 

only with your pics , i've just written a small macro.   

i hope it be of help.

 

best regards

 

sjoo

 

Sub compile_manager()
    Dim s1 As Worksheet
    Dim s2 As Worksheet
   
    Dim i As Long
   
    Dim strEmployee As String
    Dim strRecipient As String
    Dim varRecipients
   
    Dim rngEmp As Range
    Dim rngEmployees As Range
    Dim rngRec As Range
    Dim rngRecipients As Range
   
    Set s1 = ThisWorkbook.Worksheets("Sheet1")
    Set s2 = ThisWorkbook.Worksheets("Sheet2")
   
   
    Set rngEmployees = s1.Range(s1.Range("F2"), s1.Range("F2").End(xlDown))
    Set rngRecipients = s2.Range(s2.Range("B2"), s2.Range("B2").End(xlDown))
   
    For Each rngEmp In rngEmployees.Cells
        strEmployee = LCase(rngEmp.Value)
       
        For Each rngRec In rngRecipients.Cells
           
            '// split names with a seperator ","
            varRecipients = Split(rngRec.Value, ",")
           
            '// looping names
            For i = 0 To UBound(varRecipients)
               
                strRecipient = LCase(varRecipients(i))
               
                '// compare two names
                If strEmployee = strRecipient Then
                   
                    '// copy email & first-last name to the sheet1
                    rngEmp.Offset(0, 1) = rngRec.Offset(0, 1) & " " & rngRec.Offset(0, 2)
                    rngEmp.Offset(0, -1) = rngRec.Offset(0, -1)
                    GoTo NEXT_REC
                End If
               
            Next
           
        Next

NEXT_REC:

    Next
End Sub

Answer 2

Thank you so much for the code, i honestly didn't expect anyone to actually draft me out a full solution - not that im complaining!!

I have copied the code in and am trying to understand it so i can make any minor tweaks that are needed to get it working.  I have never used range before - i take it this works similar to a vlookup in this sense.

I am working my way through it but not sure what it does to the second sheet as it doesn't work 100% when i run it in its current state.  Does there have to be data in the second sheet or will it work if it was blank?

Answer 3

yes, the code copies the data from the second sheet. but i didn't make the code check blank.

 

if sheet1's F column(employees's name) & sheet2's B column(recipients) have a blank cell,

the range address is from the second row to row before blank cell.

for example,

B column has data from row 2 to row 10. but row 5 has a blank.

the code, Set rngRecipients = s2.Range(s2.Range("B2"), s2.Range("B2").End(xlDown)) takes addresses from row2 to row4

so the rngRecipients has "B2:B4" address. the other address(B5:B10) will be ignored. 

 

and i missed some codes that check a blank following comma in the recipients column.

recipient column has names seperated with comma. 

you need to add the TRIM function to delete the blank.

'-------------------------------------------------------------------

    For Each rngEmp In rngEmployees.Cells
        strEmployee = LCase(Trim(rngEmp.Value))
       
        For Each rngRec In rngRecipients.Cells
           
            '// split names with a seperator ","
            varRecipients = Split(rngRec.Value, ",")
           
            '// looping names
            For i = 0 To UBound(varRecipients)
               
                strRecipient = LCase(Trim(varRecipients(i)))
               
                '// compare two names
                If strEmployee = strRecipient Then
                   
                    '// copy email & first-last name to the sheet1
                    rngEmp.Offset(0, 1) = rngRec.Offset(0, 1) & " " & rngRec.Offset(0, 2)
                    rngEmp.Offset(0, -1) = rngRec.Offset(0, -1)
                    GoTo NEXT_REC
                End If
               
            Next
           
        Next

NEXT_REC:

    Next
 '----------------------------

 

 

Answer 4

HI, thanks i understand it better now.  I think i need to explain better what i am trying to achieve here.  I basically start of with sheet 1 and have nothing in sheet 2.  I want to loop through all the rows of data in sheet 1 and from it, be able to produce something similar to what you see on sheet 2.  Really what i'm looking for is to have each manager listed with the employees that report to him.

I will have a go now and try to amend the code!

Answer 5

Ok so i am trying a slightly different approach here.  I've got the manager list working on the second sheet so simply need to use an IF statement to compare each row of data in the first sheet to the list of managers in the second one and if they match then copy the employee to the cell beside that manager.

 

Code Snippet

Option Explicit

Sub manager_list()

Dim rngManager As Range
Dim rngList, c As Range
Dim x As Integer

Dim Manager As String

Dim s1, s2 As Worksheet

Set s1 = ThisWorkbook.Worksheets("Sheet1")
Set s2 = ThisWorkbook.Worksheets("Sheet2")

Set rngManager = s1.Range(s1.Range("E2"), s1.Range("E2").End(xlDown))
Set rngList = s2.Range(s2.Range("A2"), s2.Range("A2").End(xlDown))

rngManager.AdvancedFilter xlFilterCopy, CopyToRange:=rngList, Unique:=True

Manager = "E" & x

For x = 2 To 1000

    For Each c In rngList.Cells

        If Range(Manager).Value = c.Value Then
            MsgBox ("TEST")
        Else
        'Insert code here to copy the employees name and concatenate it in the cell
        'next to the manager in sheet 2
        End If
    Next
Next

End Sub

 

 I just keep getting an error with the line above?  Can't figure it out!

Answer 6

Just an update to the thread as Sjoo kindley helped me via email.  Here is the current state:

 

Code Snippet

Sub manager_list()

Dim rngManager As Range
Dim rngList  As Range, c As Range
Dim x As Integer

Dim Manager As String

Dim s1, s2 As Worksheet

Set s1 = ThisWorkbook.Worksheets("Sheet1")
Set s2 = ThisWorkbook.Worksheets("Sheet2")

Set rngManager = s1.Range(s1.Range("E2"), s1.Range("E2").End(xlDown))
Set rngList = s2.Range(s2.Range("A2"), s2.Range("A2").End(xlDown))

rngManager.AdvancedFilter xlFilterCopy, CopyToRange:=rngList, Unique:=True

For x = 2 To 1000

Manager = "E" & x

    For Each c In rngList.Cells
       
        If s1.Range(Manager).Value = c.Value Then
        'Insert code here to copy the employees name it in to the cell
        'next to the manager and concatenate any other names added under this manager
        Else
        'go to next record
        End If
    Next
   
Next
End Sub

 

 I am now trying to work on the final part of the macro where i need to copy the employee's name to the cell next to the manager on sheet 2 and concatenate any others employees that may be under him into the same cell.

 

Thanks