Restructure format of a worksheet

[techissue2008]

Hi

I have a sheet1:

(A1) 1 (B1) ABC (C1) 90
(A2) 1 (B2) DEF (C2) 80
(A3) 2 (B3) ABC (C3) 70
(A3) 2 (B3) DEF (C3) 60

I want to present it in sheet2 to be

(A1) (B1) 1 (C1) 2
(A2) ABC (B2) 90 (C2) 70
(A3) DEF (B3) 80 (C3) 60

(A:A) needs to sort by name

How can I code it?

Here is the sorting code:

Sub test()
Dim nodupes As New Collection
  With Sheets("Sheet1")
    For Each ce In .Range("A1:B" & .Cells(Rows.Count, 2).End(xlUp).Row)
      On Error Resume Next
      nodupes.Add Item:=ce.Value, key:=ce.Value
      On Error GoTo 0
    Next ce
  End With
  
  With Sheets("Sheet2")
    .Cells.ClearContents
    For i = 1 To nodupes.Count
      .Cells(i, "A").Value = nodupes(i)
    Next i
    .Range("a1").Resize(nodupes.Count).Offset(, 1).Formula = "=len(a1)"
    .Range("A1", .Range("A1").End(xlDown)).Resize(, 2).Sort key1:=.Range("B1"), Order1:=xlAscending, header:=xlNo
    .Columns("b").Delete
End With
End Sub

It shows the text in A1, but not A2.

Thanks

 

[techissue2008]

Anyone could help?

 

[techissue2008]

I found a simliar code example
student 1 Eng A
student 1 Math B
Student 1 Hist B
Student 1 Geog C
Student 2 Eng D
Student 2 Math C
Student 2 chem D
convert it into the following format:
Eng Math Hist Geog Chem
student 1 A B B C
student 2 D C D

Type Student
    Name As String
    Engl As String
    Math As String
    Hist As String
    Geog As String
    Chem As String
End Type
'** max rows of students  **
'** CHANGE to no. of rows **
Const maxRows = 7
'***************************
Dim mStudents(1 To maxRows) As Student
Dim mNames(1 To maxRows) As String

Sub Format()
'
' Keyboard Shortcut: Ctrl+b
'
    Dim row As Integer
    Dim col As Integer
    Dim wb As Workbook
    Dim ws As Worksheet
    
    Dim txt As String
    Dim sNames As String
    Dim sClass As String
    Dim sGrade As String
    Dim ArrayIdx As Integer
    
    Set wb = Application.ActiveWorkbook
    Set ws = wb.ActiveSheet
    
    'loop thru rows
    For row = 1 To maxRows
      'get cell values
      sNames = Trim(UCase(ws.Rows.Cells(row, 1)))
      sClass = Trim(UCase(ws.Rows.Cells(row, 2)))
      sGrade = Trim(UCase(ws.Rows.Cells(row, 3)))
      
      'store students data in array
      For ArrayIdx = 1 To maxRows
        mStudents(row).Name = sNames
        Select Case sClass
          Case "ENG":   mStudents(row).Engl = sGrade
          Case "MATH":  mStudents(row).Math = sGrade
          Case "HIST":  mStudents(row).Hist = sGrade
          Case "GEOG":  mStudents(row).Geog = sGrade
          Case "CHEM":  mStudents(row).Chem = sGrade
        End Select
      Next ArrayIdx
    Next row
    
    Set ws = Nothing
    Set wb = Nothing
    
    UniqueNames
    PutWorksheet
End Sub

Sub PutWorksheet()
  Dim row As Integer
  Dim col As Integer
  Dim wb As Workbook
  Dim ws As Worksheet
  Dim txt As String
  
  Set wb = Application.ActiveWorkbook
  Set ws = wb.Sheets("Sheet2")
  'column titles
  ws.Rows.Cells(1, 1) = "STUDENT"
  ws.Rows.Cells(1, 2) = "ENGL"
  ws.Rows.Cells(1, 3) = "MATH"
  ws.Rows.Cells(1, 4) = "HIST"
  ws.Rows.Cells(1, 5) = "GEOG"
  ws.Rows.Cells(1, 6) = "CHEM"
  
  'put names in new worksheet
  For row = 1 To maxRows
    ws.Rows.Cells(row + 1, 1) = mNames(row)
  Next row
  'put grades next to student names
  Dim myRow As Integer
  For row = 1 To maxRows
    For myRow = 1 To maxRows
    If mStudents(row).Name = ws.Rows.Cells(myRow + 1, 1) Then
      If mStudents(row).Engl <> "" Then ws.Rows.Cells(myRow + 1, 2) = mStudents(row).Engl
      If mStudents(row).Math <> "" Then ws.Rows.Cells(myRow + 1, 3) = mStudents(row).Math
      If mStudents(row).Hist <> "" Then ws.Rows.Cells(myRow + 1, 4) = mStudents(row).Hist
      If mStudents(row).Geog <> "" Then ws.Rows.Cells(myRow + 1, 5) = mStudents(row).Geog
      If mStudents(row).Chem <> "" Then ws.Rows.Cells(myRow + 1, 6) = mStudents(row).Chem
    End If
    Next myRow
  Next row
  Set ws = Nothing
  Set wb = Nothing
End Sub

Sub UniqueNames()
  Dim i As Integer
  Dim j As Integer
  Dim Name1 As String
  Dim Name2 As String
  
  Name1 = ""
  j = 0
  
  For i = 1 To maxRows
    Name2 = mStudents(i).Name
    'put unique names into array
    If Name1 <> Name2 Then
      j = j + 1
      mNames(j) = Name2
      Name1 = Name2
    End If
  Next i
End Sub

However, it just shows
STUDENT ENGL MATH HIST GEOG CHEM
in sheet 2.
How can it work without defining strings?
Just use the cell and range of worksheet.