the code will move the data from sheet 1 to sheet 2

Dim Prefix As String
Dim Suffix As String

With Sheets("sheet2")
Range("A1") = "Batch Ref"
Range("B1") = "Test Name"
Range("C1") = "Test 1"
Range("D1") = "Test 2"
Range("E1") = "Test 3"
Range("F1") = "Test 4"
NewRow = 2
End With

With Sheets("Sheet1")
Columns("$B:$E").NumberFormat = "0.00"
RowCount = 2
Do While .Range("A" & RowCount) < ""

Data = .Range("A" & RowCount)
'remove any place where the are two spaces in a row
Do While InStr(Data, " ") 0
Data = Replace(Data, " ", " ")
Loop

DataArray = Split(Data)
OldBatchNumber = .Range("A" & RowCount)
Prefix = Left(OldBatchNumber, InStr(OldBatchNumber, "-"))
Suffix = Mid(OldBatchNumber, InStr(OldBatchNumber, "-") + 1)
'remove strings after first space
Suffix = Left(Suffix, 4)
StartNum = Val(Left(Suffix, 2))
EndNum = Val(Right(Suffix, 2))

With Sheets("sheet2")
For BatchNum = StartNum To EndNum
NewBatchNum = Prefix & Format(BatchNum, "00")
Range("A" & NewRow) = NewBatchNum
For Index = 1 To 5
Cells(NewRow, Index + 1) = DataArray(Index)
Next Index
NewRow = NewRow + 1
Next BatchNum
End With
RowCount = RowCount + 1
Loop

End With


End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=164405

Microsoft Office Help