Sorting in Excel VBA

[Ethen5155]

Hi all,

well i'm just need a simple help or any hint for this case

i need to go through the active opened excel file then look for any Row start with "Subject" or any other defined words previously with match case then copy the content to opposite cell to a new .xlsx file at the same path on range (A2) and sort the all other records under it


"Subject" -----> (A2) and sort the rest under it
"German" -----> (B2) and sort the rest under it
"English" -----> (C2) and sort the rest under it
.
.
......etc

as shown below on screenshot


18268


18269

Sample file attached


any help or advise please??

Thanks in advance

Cheers

Ethen


Cross-Posting: http://www.excelforum.com/showthread.php?t=1172907&p=4577233#post4577233

[JBeaucaire]

Assuming for now two sheets in the workbook.... DATA with the raw data and OUTPUT to write the new table into:

Option Explicit
Sub ReformatClassInfo()
Dim arrDATA As Variant, arrOUT As Variant
Dim LR As Long, r As Long, c As Long, NR As Long
With Sheets("Data")
LR = .Range("A" & .Rows.Count).End(xlUp).Row
ReDim arrDATA(1 To LR, 1 To 7)
arrDATA = .Range("A1:G" & LR).Value
End With
ReDim arrOUT(1 To LR * 9, 1 To 2)
NR = 1
For r = 1 To LR
arrOUT(NR, 1) = "Subject"
arrOUT(NR + 1, 1) = "German"
arrOUT(NR + 2, 1) = "English"
arrOUT(NR + 3, 1) = "The Term"
arrOUT(NR + 4, 1) = "Keynote Speech"
arrOUT(NR + 5, 1) = "Term"
arrOUT(NR + 6, 1) = "Keyword"

arrOUT(NR, 2) = arrDATA(r, 1)
arrOUT(NR + 1, 2) = arrDATA(r, 2)
arrOUT(NR + 2, 2) = arrDATA(r, 3)
arrOUT(NR + 3, 2) = arrDATA(r, 4)
arrOUT(NR + 4, 2) = arrDATA(r, 5)
arrOUT(NR + 5, 2) = arrDATA(r, 6)
arrOUT(NR + 6, 2) = arrDATA(r, 7)
NR = NR + 8
Next r
With Sheets("Output")
.UsedRange.ClearContents
.Range("A1").Resize(UBound(arrOUT, 1), 2).Value = arrOUT
.Columns.AutoFit
.Activate
End With
End Sub

[Ethen5155]

Dear Jerry,
Thanks for your reply and i hope you are doing well

well sorry again i think it is my fault didn't explain it detailed

please find that attached sample 2 file

here is the result i want to get

From Data tab to Output tab

all the cells that are next to Red cells (Arabic) are sorted in column (A) at Output tab
and all cells that are next to Green cells (English) are sorted in column (B) at output tab

the same thing to all cells next to (Term Arabic) and (Term English) are sorted in column (C) and (D)

note that there will not be any colors in the file, i'm just explaining

1827918279


so i just want the template code for that and i will edit it at two places

1- the cells to be found then copy the cell next to it
2- the destination that will copy to at second tab

i hope you get what i mean and sorry again for disturbing you really

you are my savior

cheers

Ethen

[Ethen5155]

Solved by JBeaucaire (http://www.vbaexpress.com/forum/member.php?54720-JBeaucaire)



Option Explicit
Sub ReformatClassInfo()
Dim arrDATA As Variant, arrOUT As Variant
Dim LR As Long, r As Long, c As Long, NR As Long, Rws As Long

With Sheets("Data")
LR = .Range("A" & .Rows.Count).End(xlUp).Row
ReDim arrDATA(1 To LR, 1 To 2)
arrDATA = .Range("A1:B" & LR).Value
Rws = WorksheetFunction.CountIf(.Range("A:A"), "Subject")
End With

ReDim arrOUT(1 To Rws, 1 To 4)

For r = 1 To LR
Select Case arrDATA(r, 1)
Case "Subject"
NR = NR + 1
Case "Arabic"
arrOUT(NR, 1) = arrDATA(r, 2)
Case "English"
arrOUT(NR, 2) = arrDATA(r, 2)
Case "Term Arabic"
arrOUT(NR, 3) = arrDATA(r, 2)
Case "Term English"
arrOUT(NR, 4) = arrDATA(r, 2)
End Select
Next r

With Sheets("Output")
.UsedRange.ClearContents
.Range("A1").Resize(UBound(arrOUT, 1), 4).Value = arrOUT
.Columns.AutoFit
.Activate
End With End Sub