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

Thank you very much for your post Joel


just a small problem in running this sub.......

get a runtime error 9 subscript out of range............breaks at code line
below


Cells(NewRow, Index + 1) = DataArray(Index)


and the data on sheet1 looks like this at that point

Batch Ref Test Name Test 1 Test 2 Test 3 Test 4
0001-01 GB 7.05 7.49 0.23 0.48
0001-0304 GB 7.22 7.91 0.23 0.48
0002-0102 SA 6.87 7.57 0.23 0.48
0002-0304 SA 6.77 7.33 0.24 0.48
0003-0102 PJ 7.17 7.61 0.23 0.49
0003-0304 PJ 7.11 4.72 0.23 0.60
0004-0106 PG 13.50 5.00 0.30 0.70

For some reason there isn't 7 columns of data. the code uses the split
method to seperate the columns around blanks. If ther is another
invisible character besides a space (like a tab) then the split function
would only get 6 or less columns and will give this error. Try
replacing the following line

from
For Index = 1 To 5


to

For Index = 1 To Ubound(DataArray)

The code will run but probably some lines of data will not look
correct. Let me know which lines don't give correct results. I noticed
when you posted the data that some lines had two spaces between columns
instead of 1. I then had to add the following lines to get rid of
double spaces.

Do While InStr(Data, " ") 0
Data = Replace(Data, " ", " ")
Loop

I just noticed the posted code got changed. Replace the 6 X's below
with spaces. The lines above are missing some spaces


Data = Replace(Data, vbtab, "X") 'I added this line to handle tab
characters

Do While InStr(Data, "XX") 0
Data = Replace(Data, "XX", "X")
Loop


these lines of code are suppose to leave only one space between each
columns.


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

Microsoft Office Help

Sorry Joel
I think my initial post & paste caused confusion ......here is the source data again............... I only ever had 6 separate spreadsheet columns.
6 columns A - F below

I will try to interpret and use your last explanation - but will still value any final thoughts from you.


Batch Ref Test Name Test 1 Test 2 Test 3 Test 4
0001-0102 GB 7.05 7.49 0.23 0.48
0001-0304 GB 7.22 7.91 0.23 0.48
0002-0102 SA 6.87 7.57 0.23 0.48
0002-0304 SA 6.77 7.33 0.24 0.48
0003-0102 PJ 7.17 7.61 0.23 0.49
0003-0304 PJ 7.11 4.72 0.23 0.60
0004-0106 PG 13.50 5.00 0.30 0.70



steve


oel" wrote in message ...

For some reason there isn't 7 columns of data. the code uses the split
method to seperate the columns around blanks. If ther is another
invisible character besides a space (like a tab) then the split function
would only get 6 or less columns and will give this error. Try
replacing the following line

from
For Index = 1 To 5


to

For Index = 1 To Ubound(DataArray)

The code will run but probably some lines of data will not look
correct. Let me know which lines don't give correct results. I noticed
when you posted the data that some lines had two spaces between columns
instead of 1. I then had to add the following lines to get rid of
double spaces.

Do While InStr(Data, " ") 0
Data = Replace(Data, " ", " ")
Loop

I just noticed the posted code got changed. Replace the 6 X's below
with spaces. The lines above are missing some spaces


Data = Replace(Data, vbtab, "X") 'I added this line to handle tab
characters

Do While InStr(Data, "XX") 0
Data = Replace(Data, "XX", "X")
Loop


these lines of code are suppose to leave only one space between each
columns.


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

Microsoft Office Help

I wrote the code to work with your 6 columns. I wrote 7 by mistake in
my last posting. I looked at the code and saw the FOR statement (1 to
5) and took the 5 and added two (the BatchNumber and the two letter ID)
the to get seven. I forgot the two letter ID was included in the 5 and
should of only added 5 + 1 = 6. The changes I suggested should of fixed
the problem.

from
Do While InStr(Data, " ") 0
Data = Replace(Data, " ", " ")
Loop

to
Data = Replace(Data, vbtab, "X") 'Add line if there tabs seperate
columns.

Do While InStr(Data, "XX") 0
Data = Replace(Data, "XX", "X")
Loop


Where the X's are replaced with spaces


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

Microsoft Office Help

Joel, I hope you can bear with me.

The version of your code that seemed to run here was as below (having
followed your posts), but produced an anomalous result

Batch Ref Test Name Test 1 Test 2 Test 3 Test 4
0001-01 GB 1.10 1.20 1.30 1.40
0001-02 PJ 2.00 2.10 2.20 2.30
0001-02
0001-02
0001-02
0001-02
0001-02
0001-02
0001-02
0001-02
0001-02


the entry in cell A3 (to the left of PJ) was another Batch ref which I had
made 0002-0104.
The original entry in cell A2 was 0001-0102 (as below)
The extra data rows created in Column A numbered 51,000 before I broke the
code

Batch Ref Test Name Test 1 Test 2 Test 3 Test 4
0001-0102 GB 1.10 1.20 1.30 1.40
0002-0104 PJ 2.00 2.10 2.20 2.30


Batch Ref Test Name Test 1 Test 2 Test 3 Test 4
0001-01 GB 1.10 1.20 1.30 1.40
0001-02 GB 1.10 1.20 1.30 1.40
0002-01 PJ 2.00 2.10 2.20 2.30
0002-02 PJ 2.00 2.10 2.20 2.30
0002-03 PJ 2.00 2.10 2.20 2.30
0002-04 PJ 2.00 2.10 2.20 2.30



Sub Propagate_Rows()

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("$C:$F").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
Data = Replace(Data, vbTab, " ") 'I added this line to handle tab
Characters
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 UBound(DataArray)
Cells(NewRow, Index + 1) = DataArray(Index)
Next Index
NewRow = NewRow + 1
Next BatchNum
End With
RowCount = RowCount + 1
Loop

End With


End Sub

I found a few minor problems with th code that sholdn't of effected the
results. I left out some periods which indicate to use the "WITH"
property in the code. The only bad results would of been some data
would of been written to the wrong sheet. It is possible these errors
changed some of the cells in sheet 1. Check to make sure none of the
data in sheet 1 got changed.

Remeber in the code beow to change the lines like before replacing the
X's with spaces.

Data = Replace(Data, vbtab, "X") 'Add line if there tabs seperate
columns.

Do While InStr(Data, "XX") 0
Data = Replace(Data, "XX", "X")
Loop


I also added a new macro FindProblem to help debug the problem if the
the fixes didn't change the results. The macro writes on sheet 3 the
data from shet 1 putting each character in a seperate column along with
the ASCII equivalent number in parenthesis. I couldn't duplicate the
results you were getting. I also had problems because the posted data
actually changes some of the spaces to other characters
(white/invisible) that got weird result when I used the new macro. I
expect some of your spaces may not be spaces and need to find out what
other characters are in the data.

I don't know hwat website you are posting your request because there
are a number of websites that share their p[ostings. You can upload you
file at the following website

http://www.thecodecage.com/forumz/ne...reply&p=594393

When you reply to the posting their is a button called Manage
Attachments where you can upload a file.



Code:
--------------------
Sub Propagate_Rows()

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"
.Columns("$C:$F").NumberFormat = "0.00"
NewRow = 2
End With

With Sheets("Sheet1")
RowCount = 2
Do While .Range("A" & RowCount) < ""

Data = .Range("A" & RowCount)

'I added this line to handle tab Characters
Data = Replace(Data, vbTab, " ")

'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)

'split batch number around the dash
Prefix = Left(OldBatchNumber, InStr(OldBatchNumber, "-"))
Suffix = Mid(OldBatchNumber, InStr(OldBatchNumber, "-") + 1)

'remove strings after first space in 2nd part of batch num
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 UBound(DataArray)
.Cells(NewRow, Index + 1) = DataArray(Index)
Next Index

NewRow = NewRow + 1
Next BatchNum
End With

RowCount = RowCount + 1
Loop

End With

End Sub

Sub FindProblem()

With Sheets("sheet1")
RowCount = 2
Do While .Range("A" & RowCount) < ""
Data = .Range("A" & RowCount)

With Sheets("sheet3")
For ColCount = 1 To Len(Data)
DebugData = Mid(Data, ColCount, 1) & _
"(" & Asc(Mid(Data, ColCount, 1)) & ")"

.Cells(RowCount, ColCount) = DebugData
Next ColCount

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