# Group data from a row into different columns

#### KyleG

##### Well-known Member
In this mockup of a sheet i need a macro that will on another sheet in columns list the people with the same status
Book1
ABCDEFGHIJ
1fredgeorgeHarryRonDeanNevillebobjohnsarahlucy
2highlowaverageperfectaverageaveragelowlowhighnot worked
Sheet1
Book1
ABCDE
1Not WorkedLowAveragePerfectHIGH
2LucyGeorgeHarryRonFred
3BobDeanSarah
4johnNeville
Sheet2

Thanks

### Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

#### venkat1926

##### Well-known Member
see sheet below
rows 13 and down are AFTER MACRO
DELETE rows 13,14,15. KEEP row 12 as it is (they are unique values of status)

now again run the macro test given below modify macro to suit you)

(if necessary cut and copy rows 12 downwards into another sheet- you can incorporate this into the macro)

Code:
``````Sub test()
Dim dest As Range
Dim cfind As Range
Dim crit As Range
Dim i As Integer
Dim j As Integer
Dim rng As Range
Set rng = Range(Range("a1"), Cells(4, Columns.Count).End(xlToLeft))
Set crit = Range("a12")
line1:
With rng
Set cfind = .Find(what:=crit.Value, lookat:=xlWhole)
crit.Offset(1, 0) = cfind.Offset(-2, 0)
j = 1
i = 1
Do

On Error Resume Next
Set cfind = .FindNext(after:=cfind)
Set crit = crit.Offset(0, i)
If crit = "" Then GoTo line2
GoTo line1
End If
crit.Offset(j + 1, 0) = cfind.Offset(-2, 0)

j = j + 1

line2:

End With
MsgBox "macro over"

End Sub``````
vlookup mltiple values.xls
ABCDEFGHIJ
1
2fredgeorgeHarryRonDeanNevillebobjohnsarahlucy
3
4highlowaverageperfectaverageaveragelowlowhighnot worked
5
6
7
8
9
10
11
12highlowaveragenot worked
13fredgeorgeHarrylucy
14sarahbobDean
15johnNeville
Sheet1

#### KyleG

##### Well-known Member
I'm struggling to convert this so that it puts it automatically onto sheet2 with the headers on row A.

The other point to note is that on sheet 1 the names start in A2 and go across, and the values (high, low etc) are below them on Row 8. If you could make comments on each line of your code i might be able to translate.

Thanks

#### venkat1926

##### Well-known Member
I have modified the macro to get the results in sheet2
pre-enter the values low high etc (as in row 12 of the sheet 1) in row no. 1 of sheet2 fro A1 to the right.

now run this modified macro now called "testone". i have checked the existing row 2 and row 4 data . I have incorporated so that your data conists upto eight rows the data in alternate rows I have given comments . I could not check eight rows data because I do not have them.

still there may some bug and the macro may require slight modification to suit you which can be done by debugging-keep cursor within the macro testone and sucessively hit F8. find out where the bug comes and you can rectify.

If you cannot correct it post 8 rows data or send it to my email address as an excel file

if successful you can delete the comment lines. some comment lines are OLD code statements.

I SUGGEST YOU RUN THE FOLLOWING MACRO ON YOUR EIGHT ROW DATA AND SEE WHAT HAPPENS.

the new macro testone is :

Code:
``````Dim add As String
Dim dest As Range
Dim cfind As Range
Dim crit As Range
Dim i As Integer
Dim j As Integer
Dim rng As Range
Worksheets("sheet1").Activate
'Set rng = Range(Range("a1"), Cells(4, Columns.Count).End(xlToLeft))
'rng is your basic data consisting row2 upto row 4 or 8 with the last column in this case J
Set rng = Range(Range("a2"), Cells(8, Columns.Count).End(xlToLeft))

Set crit = Worksheets("sheet2").Range("a1")
'the unique values like high, low etc are pre-entered in row 12
line1:
With rng
Set cfind = .Find(what:=crit.Value, lookat:=xlWhole)
'it finds the first value equivalent to the value of range "crit" in the first case A12 value i.e. "high"
'you must know the address of the first find of for example "high"
'because the find value in the next findnext is cricular.
'after finding all the value in rng it comes back to the firt high value
'so the looping in the find next should stop when it come back the first "high"
crit.Offset(1, 0) = cfind.Offset(-2, 0)
j = 1
i = 1
Do

On Error Resume Next
Set cfind = .FindNext(after:=cfind)
'findnext finds the next value of "high"
'if cfind is the first high value the looping has to stop and then
Set crit = crit.Offset(0, i)
'crit should go to the next value in row 12 i.e. "low"

If crit = "" Then GoTo line2
'when crit goes beyond the four values of row 12 the macro should stop
GoTo line1
' this is only a sort of looping
End If
crit.Offset(j + 1, 0) = cfind.Offset(-2, 0)
'this statement enters the first value of the name of the person of that category crit
j = j + 1

line2:

End With

MsgBox "macro over"
End Sub``````

#### KyleG

##### Well-known Member
The cells value that contain Not worked, average etc below each persons name are actually genenerated by a formula
=IF((SUM((COUNTIF(B17:B30,0))+(COUNTIF(B17:B30,"n/a"))+((COUNTIF(B17:B30,">=-2")-COUNTIF(B17:B30,">2"))-(COUNTIF(B17:B30,0)))+(COUNTIF(B17:B30,"<-2")+COUNTIF(B17:B30,">2"))))<>14,"NES",IF((COUNTIF(B17:B30,"n/a"))>10,"NES",IF((COUNTIF(B17:B30,0))+(COUNTIF(B17:B30,"n/a"))=14,"PERFECT",IF((COUNTIF(B17:B30,"<-2")+COUNTIF(B17:B30,">2"))>=4,"POOR",IF((COUNTIF(B17:B30,"<-2")+COUNTIF(B17:B30,">2"))=0,"HIGH","AVERAGE")))))
This particlar cell returns "PERFECT" but your formula doesnt recognise it. If i take out the formula and insert PERFECT text it does.

#### venkat1926

##### Well-known Member
Code:
``Set cfind = .Find(what:=crit.Value, lookat:=xlWhole)``
change this into
Code:
``Set cfind = .Find(what:=crit.Value, lookat:=xlWhole,lookin:=xlvalues)``

now see whether you get what you want.

#### KyleG

##### Well-known Member
Spot on! thanks heaps for all your help.

Replies
0
Views
149
Replies
0
Views
265
Replies
3
Views
261
Replies
6
Views
205
Replies
4
Views
630

1,181,658
Messages
5,931,271
Members
436,785
Latest member
KingGideon

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back