Group data from a row into different columns

KyleG

Well-known Member
Joined
Jun 12, 2004
Messages
623
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
Joined
Aug 21, 2005
Messages
4,824
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 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
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)
add = cfind.Address
crit.Offset(1, 0) = cfind.Offset(-2, 0)
j = 1
i = 1
Do

On Error Resume Next
Set cfind = .FindNext(after:=cfind)
If cfind.Address = add Then
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

Loop While cfind.Address<> add
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
Joined
Jun 12, 2004
Messages
623
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
Joined
Aug 21, 2005
Messages
4,824
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"
add = cfind.Address
'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.Address = add Then
'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

Loop While cfind.Address <> add
line2:

End With

MsgBox "macro over"
End Sub
 

KyleG

Well-known Member
Joined
Jun 12, 2004
Messages
623
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
Joined
Aug 21, 2005
Messages
4,824
please see my code statement
Code:
Set cfind = .Find(what:=crit.Value, lookat:=xlWhole)
change this into
Code:
Set cfind = .Find(what:=crit.Value, lookat:=xlWhole,lookin:=xlvalues)

argument LOOKIN is the addition

now see whether you get what you want.
 

Forum statistics

Threads
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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Top