Consolidate Data onto one row

[Ivan Howard]

Hi All,

I have a small issue and have tried to write a macro for it, but I am struggling:

I have a list of staff numbers in column A... this holds duplicates. In column B, corresponding to each staff number is Apples, Bananas, Grapes, Oranges or Pears... Sometimes each person can have up to 5 entries, i.e. 5 rows...

What I need is a macro that will place each persons 'fruit preferences' onto one row, corresponding to their staff number, so that I can do a vlookup using the resulting list.

Preferrably, the staff number should remain in column A, the 1st choice should be in column B, 2nd choice in column C, 3rd choice in column D... etc.

I would really appreciate your help with this.
Thanks
Ivan

 

[Mel Smith]

Hi Ivan, if each staff member had the same number of fruit "options", even if some were left blank, it would be then straightforward to write the macro. Your current difficulty as I see it is the variable "fruits" per staff member, hence the macro not doing what you want.

Mel

 

[Ivan Howard]

Thanks Mel.

I agree, I wrote the macro and it was fine dealing with the same number of rows, but I thought that it might be possible to do a count fo the number of entries per person and then get the macro to loop that certain number of times.

I suppose there might also be a way to do an 'inventive' vlookup where I concatenate the count of each entry to the staff number and then somehow try and pull in back to the final result I am looking for.

Thanks very much for your help.

Take care.
Ivan

 

[cornflakegirl]

Ivan - don't know if you're still working on this, but try this code:

Sub MultipleRowsToOne()
 
Dim iCounter As Integer
Dim iOriginalRow As Integer
Dim iDuplicates As Integer
 
For iCounter = Range("a1").End(xlDown).Row To 1 Step -1
    iDuplicates = Evaluate("countif(a1:a" & iCounter & "," & Range("a" & iCounter).Value & ")")
    If iDuplicates > 1 Then
        iOriginalRow = Evaluate("match(" & Range("a" & iCounter).Value & ",a1:a" & iCounter & ",0)")
        Range("a" & iOriginalRow).Offset(0, iDuplicates).Value = Range("b" & iCounter).Value
        Range("a" & iCounter).EntireRow.Delete
    End If
Next iCounter
 
End Sub

 

[Ivan Howard]

Thanks very much Emma, but I cannot get this to work.

the active cell does not seem to move off the selected cell.

 

[cornflakegirl]

Ivan - the activecell doesn't change - it doesn't need to.
I tested the macro on some sample data, based on the information you gave. So my guess is that there are references that need to change to work on your actual data? Are your data actually in columns A & B, starting at cell A1?

 

[Ivan Howard]

Thanks Emma.

Yes the data started in A1 - with no titles. I have tried the staff numbers as numerics and also as text, but I cant get it to work.

However, I have used Access to query the data and it is all fine now.

Thanks very much for your help.

 

[cornflakegirl]

Bizarre. Access does sound a better way to do it. Glad you got it sorted.

 

[Ivan Howard]

Thanks again.

Take care.