Hi,

One more time. This will write over to Columns I through O and leave your
original data intact. Hope it helps.
It only takes into account the value you originally showed us:
Sub Macro1()
'Writes from Columns A through G to Columns I through O
Range("I1").Value = "NAME"
Range("J1").Value = "DATE"
Range("K1").Value = "STATUS"
Range("L1").Value = "SPORT"
Range("M1").Value = "CASE#"
Range("N1").Value = "T<IN"
Range("O1").Value = "TOUT"
Range("H2").Select
Do Until ActiveCell.Offset(0, -7).Value = ""
ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(0, -7).Value
'Test Col B -6
'Date
If ActiveCell.Offset(0, -6).Value Like "*/*/*" Then
ActiveCell.Offset(0, 2).Value = ActiveCell.Offset(0, -6).Value
End If
'Status
If ActiveCell.Offset(0, -6).Value Like "done" Or _
ActiveCell.Offset(0, -6).Value Like "ignore" Or _
ActiveCell.Offset(0, -6).Value Like "open" Or _
ActiveCell.Offset(0, -6).Value Like "pending" _
Then
ActiveCell.Offset(0, 3).Value = ActiveCell.Offset(0, -6).Value
End If
'Sport
If ActiveCell.Offset(0, -6).Value Like "basketball" Or _
ActiveCell.Offset(0, -6).Value Like "soccer" Or _
ActiveCell.Offset(0, -6).Value Like "darts" Or _
ActiveCell.Offset(0, -6).Value Like "cycling" Or _
ActiveCell.Offset(0, -6).Value Like "none" _
Then
ActiveCell.Offset(0, 4).Value = ActiveCell.Offset(0, -6).Value
End If
'Case
If ActiveCell.Offset(0, -6).Value Like "###*" Then
ActiveCell.Offset(0, 5).Value = ActiveCell.Offset(0, -6).Value
End If
'Time
If ActiveCell.Offset(0, -6).Value < 1 Then
IsTime1 = ActiveCell.Offset(0, -6).Value
End If
'Test Col C -5
If ActiveCell.Offset(0, -5).Value Like "*/*/*" Then
ActiveCell.Offset(0, 2).Value = ActiveCell.Offset(0, -5).Value
End If
'Status
If ActiveCell.Offset(0, -5).Value Like "done" Or _
ActiveCell.Offset(0, -5).Value Like "ignore" Or _
ActiveCell.Offset(0, -5).Value Like "open" Or _
ActiveCell.Offset(0, -5).Value Like "pending" _
Then
ActiveCell.Offset(0, 3).Value = ActiveCell.Offset(0, -5).Value
End If
'Sport
If ActiveCell.Offset(0, -5).Value Like "basketball" Or _
ActiveCell.Offset(0, -5).Value Like "soccer" Or _
ActiveCell.Offset(0, -5).Value Like "darts" Or _
ActiveCell.Offset(0, -5).Value Like "cycling" Or _
ActiveCell.Offset(0, -5).Value Like "none" _
Then
ActiveCell.Offset(0, 4).Value = ActiveCell.Offset(0, -5).Value
End If
'Case
If ActiveCell.Offset(0, -5).Value Like "###*" Then
ActiveCell.Offset(0, 5).Value = ActiveCell.Offset(0, -5).Value
End If
'Time
If ActiveCell.Offset(0, -5).Value < 1 Then
IsTime2 = ActiveCell.Offset(0, -5).Value
End If
'Test Col D -4
If ActiveCell.Offset(0, -4).Value Like "*/*/*" Then
ActiveCell.Offset(0, 2).Value = ActiveCell.Offset(0, -4).Value
End If
'Status
If ActiveCell.Offset(0, -4).Value Like "done" Or _
ActiveCell.Offset(0, -4).Value Like "ignore" Or _
ActiveCell.Offset(0, -4).Value Like "open" Or _
ActiveCell.Offset(0, -4).Value Like "pending" _
Then
ActiveCell.Offset(0, 3).Value = ActiveCell.Offset(0, -4).Value
End If
'Sport
If ActiveCell.Offset(0, -4).Value Like "basketball" Or _
ActiveCell.Offset(0, -4).Value Like "soccer" Or _
ActiveCell.Offset(0, -4).Value Like "darts" Or _
ActiveCell.Offset(0, -4).Value Like "cycling" Or _
ActiveCell.Offset(0, -4).Value Like "none" _
Then
ActiveCell.Offset(0, 4).Value = ActiveCell.Offset(0, -4).Value
End If
'Case
If ActiveCell.Offset(0, -4).Value Like "###*" Then
ActiveCell.Offset(0, 5).Value = ActiveCell.Offset(0, -4).Value
End If
'Time
If ActiveCell.Offset(0, -4).Value < 1 Then
IsTime3 = ActiveCell.Offset(0, -4).Value
End If
'Test Col E -3
If ActiveCell.Offset(0, -3).Value Like "*/*/*" Then
ActiveCell.Offset(0, 2).Value = ActiveCell.Offset(0, -3).Value
End If
'Status
If ActiveCell.Offset(0, -3).Value Like "done" Or _
ActiveCell.Offset(0, -3).Value Like "ignore" Or _
ActiveCell.Offset(0, -3).Value Like "open" Or _
ActiveCell.Offset(0, -3).Value Like "pending" _
Then
ActiveCell.Offset(0, 3).Value = ActiveCell.Offset(0, -3).Value
End If
'Sport
If ActiveCell.Offset(0, -3).Value Like "basketball" Or _
ActiveCell.Offset(0, -3).Value Like "soccer" Or _
ActiveCell.Offset(0, -3).Value Like "darts" Or _
ActiveCell.Offset(0, -3).Value Like "cycling" Or _
ActiveCell.Offset(0, -3).Value Like "none" _
Then
ActiveCell.Offset(0, 4).Value = ActiveCell.Offset(0, -3).Value
End If
'Case
If ActiveCell.Offset(0, -3).Value Like "###*" Then
ActiveCell.Offset(0, 5).Value = ActiveCell.Offset(0, -3).Value
End If
'Time
If ActiveCell.Offset(0, -3).Value < 1 Then
IsTime4 = ActiveCell.Offset(0, -3).Value
End If
'Test Col F -2
If ActiveCell.Offset(0, -2).Value Like "*/*/*" Then
ActiveCell.Offset(0, 2).Value = ActiveCell.Offset(0, -2).Value
End If
'Status
If ActiveCell.Offset(0, -2).Value Like "done" Or _
ActiveCell.Offset(0, -2).Value Like "ignore" Or _
ActiveCell.Offset(0, -2).Value Like "open" Or _
ActiveCell.Offset(0, -2).Value Like "pending" _
Then
ActiveCell.Offset(0, 3).Value = ActiveCell.Offset(0, -2).Value
End If
'Sport
If ActiveCell.Offset(0, -2).Value Like "basketball" Or _
ActiveCell.Offset(0, -2).Value Like "soccer" Or _
ActiveCell.Offset(0, -2).Value Like "darts" Or _
ActiveCell.Offset(0, -2).Value Like "cycling" Or _
ActiveCell.Offset(0, -2).Value Like "none" _
Then
ActiveCell.Offset(0, 4).Value = ActiveCell.Offset(0, -2).Value
End If
'Case
If ActiveCell.Offset(0, -2).Value Like "###*" Then
ActiveCell.Offset(0, 5).Value = ActiveCell.Offset(0, -2).Value
End If
'Time
If ActiveCell.Offset(0, -2).Value < 1 Then
IsTime5 = ActiveCell.Offset(0, -2).Value
End If
'Test Col G -1
If ActiveCell.Offset(0, -1).Value Like "*/*/*" Then
ActiveCell.Offset(0, 2).Value = ActiveCell.Offset(0, -1).Value
End If
'Status
If ActiveCell.Offset(0, -1).Value Like "done" _
Or ActiveCell.Offset(0, -1).Value Like "ignore" Or _
ActiveCell.Offset(0, -1).Value Like "open" Or _
ActiveCell.Offset(0, -1).Value Like "pending" _
Then
ActiveCell.Offset(0, 3).Value = ActiveCell.Offset(0, -1).Value
End If
'Sport
If ActiveCell.Offset(0, -1).Value Like "basketball" Or _
ActiveCell.Offset(0, -1).Value Like "soccer" Or _
ActiveCell.Offset(0, -1).Value Like "darts" Or _
ActiveCell.Offset(0, -1).Value Like "cycling" Or _
ActiveCell.Offset(0, -1).Value Like "none" _
Then
ActiveCell.Offset(0, 4).Value = ActiveCell.Offset(0, -1).Value
End If
'Case
If ActiveCell.Offset(0, -1).Value Like "###*" Then
ActiveCell.Offset(0, 5).Value = ActiveCell.Offset(0, -1).Value
End If
'Time
If ActiveCell.Offset(0, -1).Value < 1 Then
IsTime6 = ActiveCell.Offset(0, -1).Value
End If
'Find the times
If IsTime6 0 Then SaveTime2 = IsTime6
If IsTime5 0 Then
If SaveTime2 0 Then
SaveTime1 = IsTime5
Else
SaveTime2 = IsTime5
End If
Else
End If
If IsTime4 0 Then
If SaveTime2 0 Then
SaveTime1 = IsTime4
Else
SaveTime2 = IsTime4
End If
Else
End If
If IsTime3 0 Then
If SaveTime2 0 Then
SaveTime1 = IsTime3
Else
SaveTime2 = IsTime3
End If
Else
End If
If IsTime2 0 Then
If SaveTime2 0 Then
SaveTime1 = IsTime2
Else
SaveTime2 = IsTime2
End If
Else
End If
If IsTime1 0 Then
If SaveTime2 0 Then
SaveTime1 = IsTime1
Else
Stop
SaveTime2 = IsTime2
End If
Else
End If
ActiveCell.Offset(0, 7).Value = SaveTime2
ActiveCell.Offset(0, 7).NumberFormat = "h:mm"
ActiveCell.Offset(0, 6).Value = SaveTime1
ActiveCell.Offset(0, 6).NumberFormat = "h:mm"
IsTime1 = 0
IsTime2 = 0
IsTime3 = 0
IsTime4 = 0
IsTime5 = 0
IsTime6 = 0
SaveTime2 = 0
SaveTime1 = 0
ActiveCell.Offset(1, 0).Select
Loop
End Sub



"stefsailor" wrote:

I have received a "chaotic "sheet coming( presumably) from inorderly and
faulty mergers from different source sheets ( who are lost...), from a
collegue, to restructure it into an orderly one...
I work on Office with excel 2002

how in Godsname am i going to do this otherwise than restructure each line
manually ( sheet is over 3500 lines with 12 columns coming from a structured
but lost original ...siggh..!!!...I received a macro for doing already part
of the job ....(look further please...)

my chaos sheet looks lik this...

NAME DATE STATUS SPORT CASE# T<IN
TOUT
Lydia done 12/05/03 2367 basketball 12:31
14:45
Bert 23/08/07 12:33 356899 14:23 pending
darts
Kevin ignore 24/08/05 11:56 soccer 124587
22:30
Lydia 12:30 done 56875585 none 18/04/95
18:22
Bert open 458 cycling 11:22
10/02/1999 18:16

what i need in the end is "of course...":

NAME DATE STATUS SPORT CASE# TIN
TOUT
Bert 23/08/07 pending darts 356899 12:33
14:23
Bert 10/02/1999 open cycling 458
11:22 18:16
Lydia 12/05/03 done basketball 2367 12:31
14:45
Lydia 18/04/95 done none 56875585 12:30
18:22
Kevin 24/08/05 ignore soccer 124587 11:56
22:30

the only remaining consistencies from the source spreadsheets in that
chaotic sheet
a
Names always in the first collumn A
the dates are in the format as shown,
sometimes full year 4 digits i.e.: "1999"
sometimes only the two last digits for the year i.e. : "05"
the time format is always custom: h:mm
the start time data entries in the same row are always preceding the
outgoing time entries ( later i have to perform a duration calculation on
those times in an extra column)
from row to row this time entries change their positions but always start
time before end time ...
The other columns are text formats
and the text entry corresponding to the "STATUS" heading "quality" always
preceeds the text entry corresponding to the "SPORT" quality
I found no other consistencies than this
like i said earlier I have already a macro who picks up the dates from each
row and puts it in an orderly colum under DATE
I have to select the entire sheet under the titles from A2 till G6 and then
I let the macro run and it does this:

NAME DATE STATUS SPORT CASE# TI TOUT
Lydia 12/05/03 done 2367 basketball 12:31 14:45
Bert 23/08/07 12:33 356899 14:23 pending darts
Kevin 24/08/05 ignore 11:56 soccer 124587 22:30
Lydia 18/04/95 12:30 done 56875585 none 18:22
Bert 10/02/99 open 458 cycling 11:22 18:16

which looks a lot better already
the macro goes like this

Sub sandy()
On Error Resume Next
Dim DRange As Range, mCell As Range
For Each mCell In Selection
If IsDate(mCell) = True And Not mCell.Column = 2 Then
mCell.Cut
Cells(mCell.Row, "B").Insert (xlToRight)
End If
Next
Application.CutCopyMode = False
For Each mCell In Range("B2", Cells(Columns(2).Rows.Count, "B").End(xlUp))
mCell.Value = CDate(mCell)
Trim (mCell)
mCell.NumberFormat = "dd/mm/yy"
mCell.HorizontalAlignment = xlCenter
Next
[A1].Select
End Sub

i've called it "SANDY" in honour to the person who wrote it for me on
another forum
I cannot write any macro's ...and Sandy has dissappeared...sadly...
My question ...
Can anyone else maybe continue this routine and add the next step
maybe sort out the time entries in two further juxtaposed collumns
just like the Sandy macro does with the dates...?
maybe then the rest of it will "fall into place" much better already

thanks for keeping with me so far
and all help will be deeply appreciated
stef