Sub Rearrange()
Dim a As Variant, b As Variant, Bits As Variant
Dim i As Long, j As Long, k As Long, c As Long, uba2 As Long
With Sheets("Sheet1")
a = .Range("A1").CurrentRegion.Value
uba2 = UBound(a, 2)
End With
ReDim b(1 To Rows.Count, 1 To uba2)
For i = 1 To UBound(a)
Bits = Split(a(i, 2), ";")
For c = 0 To UBound(Bits)
k = k + 1
b(k, 1) = a(i, 1): b(k, 2) = Bits(c)
For j = 3 To uba2
b(k, j) = a(i, j)
Next j
Next c
Next i
With Sheets("Sheet2").Range("A1").Resize(k, uba2)
.Value = b
.Columns.AutoFit
End With
End Sub
Option Explicit
Sub test()
Dim Lr&, i&, j&, k&, cell As Range, s, arr()
With Sheets("Sheet1")
Lr = .Cells(Rows.Count, "A").End(xlUp).Row
ReDim arr(1 To 65000, 1 To 8)
For Each cell In .Range("B3:B" & Lr)
s = Split(cell, ";")
For i = 0 To UBound(s)
k = k + 1
For j = -1 To 6
arr(k, j + 2) = cell.Offset(0, j).Value
If j = 0 Then arr(k, j + 2) = s(i)
Next
Next
Next
End With
With Sheets("Sheet2")
Sheets("Sheet1").Range("A2:H2").Copy .Range("A2")
.Range("A3").Resize(k, 8).Value = arr
.Range("A3").Resize(k, 8).Borders.LineStyle = xlContinuous
End With
End Sub
Book1 | ||||||||||
---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | |||
1 | ||||||||||
2 | Group | Name | Subject | Marks | P | C | O | C | ||
3 | Green | David;Matt | Matchs | -10 | a | fg | u | sd | ||
4 | Green | Golia | Matchs | -20 | b | ghj | j | adf | ||
5 | Red | Golia | Matchs | -20 | c | fg | g | h | ||
6 | Blue | David;Matt;Henry | English | 0.0001 | f | ghg | g | dfg | ||
7 | Blue | Danish | English | -0.0002 | e | gfh | df | sdf | ||
Sheet1 |
Book1 | ||||||||||
---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | |||
2 | Group | Name | Subject | Marks | P | C | O | C | ||
3 | Green | David | Matchs | -10 | a | fg | u | sd | ||
4 | Green | Matt | Matchs | -10 | a | fg | u | sd | ||
5 | Green | Golia | Matchs | -20 | b | ghj | j | adf | ||
6 | Red | Golia | Matchs | -20 | c | fg | g | h | ||
7 | Blue | David | English | 0.0001 | f | ghg | g | dfg | ||
8 | Blue | Matt | English | 0.0001 | f | ghg | g | dfg | ||
9 | Blue | Henry | English | 0.0001 | f | ghg | g | dfg | ||
10 | Blue | Danish | English | -0.0002 | e | gfh | df | sdf | ||
Sheet2 |
Like this?Can I get the rows sorted in descending order of marks by subject (one below another)?
Sub Rearrange_v2()
Dim a As Variant, b As Variant, Bits As Variant
Dim i As Long, j As Long, k As Long, c As Long, uba2 As Long
With Sheets("Sheet1")
a = .Range("A1").CurrentRegion.Value
uba2 = UBound(a, 2)
End With
ReDim b(1 To Rows.Count, 1 To uba2)
For i = 1 To UBound(a)
Bits = Split(a(i, 2), ";")
For c = 0 To UBound(Bits)
k = k + 1
b(k, 1) = a(i, 1): b(k, 2) = Bits(c)
For j = 3 To uba2
b(k, j) = a(i, j)
Next j
Next c
Next i
Application.ScreenUpdating = False
With Sheets("Sheet2").Range("A1").Resize(k, uba2)
.Value = b
.Columns.AutoFit
.Sort Key1:=.Columns(3), Order1:=xlAscending, _
Key2:=.Columns(4), Order2:=xlDescending, _
Header:=xlYes
.Parent.Activate
End With
Application.ScreenUpdating = True
End Sub
You would need to explain that more fully and/or give some small sample data and the results you mean by this.And get the least ten in sheet3 in descending order of marks by subject (one below another)?
No, it is not clear as you did not address my last question..As there are more than 50 thousand rows so it is not easy for me to know the lowest 10 of say, David or Goliath. There are hundreds of names.
And I want to know the lowest 10 of each name in each subject.
Hope I am clear now.
So, did my latest code produce the Sheet2 results that you wanted? (No point in proceeding if the first part is not what you want)