Scott Boyd


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




Re: Stuck on logic for Excel problem...

sjoo


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






Re: Stuck on logic for Excel problem...

Scott Boyd

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





Re: Stuck on logic for Excel problem...

sjoo

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
'----------------------------





Re: Stuck on logic for Excel problem...

Scott Boyd

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! Smile




Re: Stuck on logic for Excel problem...

Scott Boyd

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!





Re: Stuck on logic for Excel problem...

Scott Boyd

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 Smile