transformation of data?

Hi

I have attached a sample to see if that is what you are looking for, where duplicates occur in the class it is becasue the originals are a little different.

Please let me know if you would like something different.

Regards


Jeff

THank you so much for looking at this problem. There are two points though,

Your solution is half way there. When I hit the format button you created, it outputs to the rev worksheet with the students and their subjects BUT it needs to bring the data with it with column D, E, F, etc with the data from the other worksheets on the original sheet. So that the output is like the one attached or even dumped into the one attached

Secondly, I don't see how you got to where you did. How did you do that? You know something about Excel that I have never seen. Can you point me in the right direction?

Hi

Here is a revised version that copies data as well.

However you will note that there are some gaps in the data, as far as I can tell it is where columns have been transposed in some of the sheets, i.e. teacher a to b and vice versa, I think it should be okay if this is corrected.

If I get a chance later I will try and explain a bit more.

Regards

Jeff

Well, that's certainly worked though I don't know how you made it do it.

Thank you so much. If you get time, please point me in the right direction of how you did it.

Schall

Hi

As requested I have commented the code, please feel free to ask about anything you are not sure of.

Sub format_teacher()

Dim a As Integer
'************************************************************************************************************
'Checks the details of the classes and if the text contains "Tb" marks a "b", if it contains "Tc" marks a "c"
'or if neither an "a"
'************************************************************************************************************
For a = 2 To 73

With Sheets("Punctuality").Cells(3, a)
    Set c = .Find("Tb", LookIn:=xlValues)
    If Not c Is Nothing Then
        Let Cells(1, a).Value = "b"
    End If
End With

With Sheets("Punctuality").Cells(3, a)
    Set c = .Find("Tc", LookIn:=xlValues)
    If Not c Is Nothing Then
        Let Cells(1, a).Value = "c"
    End If
End With

If Cells(1, a).Value = "" Then Let Cells(1, a).Value = "a"

Next a

End Sub

Sub format_heading()

Dim a As Integer, b As Integer, c As Integer, d As String

'*****************************************************************************************************************
'Checks for the first space and removes anything before that, also removes "Tb " and "Tc ", cpies to temp location
'*****************************************************************************************************************

For a = 2 To 73

Let c = Len(Cells(3, a))
Let b = InStr(1, Cells(3, a), " ")
Let d = Right(Cells(3, a), c - b)
Let Cells(2, a).Value = d
Next a

    Rows(2).Replace What:="Tb ", Replacement:="", LookAt:=xlPart
    Rows(2).Replace What:="Tc ", Replacement:="", LookAt:=xlPart

End Sub

Sub copy_data()

Dim a As Integer, b As Integer, c As Integer, d As Integer, x As String

Application.ScreenUpdating = False
'****************************************************************
'Inserts two rows on the punctuation page to place temporary data
'****************************************************************
    Rows("1:2").Select
    Selection.Insert Shift:=xlDown
    Rows(2).RowHeight = 150
    Rows(2).Orientation = 90

Call format_teacher
Call format_heading

'******************************
'Copies Headings to "Rev" sheet
'******************************

Sheets("Rev").Select
Let Cells(1, 1).Value = "Student Name"
Let Cells(1, 2).Value = "Class Name"
Let Cells(1, 3).Value = "Teacher"

For d = 3 To 7
Let x = Sheets(d).Name
Let Cells(1, d + 1).Value = x
Next d
Columns("c:g").ColumnWidth = 12

'**********************************************
'Copies details for each student to "Rev" sheet
'**********************************************

For a = 4 To 213
'**********************************
'Copies Student name to "rev" sheet
'**********************************
Let Sheets("rev").Cells(Sheets("Rev").Cells(1, 15).Value + 1, 1).Value = Sheets("Punctuality").Cells(a, 1).Value
'**************************************************************
'Copies details for each student's teachers, classes and grades
'**************************************************************
For c = 2 To 73
If Sheets("Punctuality").Cells(a, c).Value <> "" Then
'****************************************************************************************************************
'Sheets("Rev").Cells(1, 15).Value enables data to be copied to the right place by counting the number of teachers
'****************************************************************************************************************

'****************************
'Copies class detais to "Rev"
'****************************
If Sheets("Rev").Cells(1, 15).Value = 0 Then
Let Sheets("rev").Cells(Sheets("Rev").Cells(1, 15).Value + 1, 2).Value = Sheets("Punctuality").Cells(2, c).Value
ElseIf Sheets("rev").Cells(Sheets("Rev").Cells(1, 15).Value, 2).Value <> Sheets("Punctuality").Cells(2, c).Value Then
Let Sheets("rev").Cells(Sheets("Rev").Cells(1, 15).Value + 1, 2).Value = Sheets("Punctuality").Cells(2, c).Value
End If
End If
'****************************************************
'Copies teacher details and grades from "Punctuality"
'****************************************************
If Sheets("Punctuality").Cells(a, c).Value <> "" Then
Let Sheets("rev").Cells(Sheets("Rev").Cells(1, 15).Value + 1, 3).Value = Sheets("Punctuality").Cells(1, c).Value
Let Sheets("rev").Cells(Sheets("Rev").Cells(1, 15).Value, 4).Value = Sheets("Punctuality").Cells(a, c).Value
'***********************************
'Copies grades from all other sheets
'***********************************
For d = 4 To 7
If Sheets(d).Cells(a - 2, c).Value <> "" Then
Let Sheets("rev").Cells(Sheets("Rev").Cells(1, 15).Value, d + 1).Value = Sheets(d).Cells(a - 2, c).Value
End If
Next d
End If
Next c
Next a
Sheets("Punctuality").Rows("1:2").Delete
Application.ScreenUpdating = True
End Sub

Regards

Jeff