Could someone kindly offer a solution/vbscript to copy and populate rows of
data (adjusting the text string in Column A as part of the process) as
illustrated below.

The top section is an example of the source data containing batch numbers
with associated data in adjacent columns
The batch numbers in Column A will always be in this format/length
The second part of the string in column A dictates the range of individual 2
digit suffixes that the batch number / row of data pertains to

Hopefully the intention can be seen in the illustration below

Batch Ref Test1 Test2 Test3 Test4
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-0103 PJ 7.17 7.61 0.23 0.49
0003-0406 PJ 7.11 4.72 0.23 0.60
0004-0106 PG 13.50 5.00 0.30 0.70




required result

0001-01 GB 7.05 7.49 0.23 0.48
0001-02 GB 7.05 7.49 0.23 0.48
0001-03 GB 7.22 7.91 0.23 0.48
0001-04 GB 7.22 7.91 0.23 0.48
0002-01 SA 6.87 7.57 0.23 0.48
0002-02 SA 6.87 7.57 0.23 0.48
0002-03 SA 6.77 7.33 0.24 0.48
0002-04 SA 6.77 7.33 0.24 0.48
0003-01 PJ 7.17 7.61 0.23 0.49
0003-02 PJ 7.17 7.61 0.23 0.49
0003-03 PJ 7.17 7.61 0.23 0.49
0003-04 PJ 7.11 4.72 0.23 0.6
0003-05 PJ 7.11 4.72 0.23 0.6
0003-06 PJ 7.11 4.72 0.23 0.6
0004-01 PG 13.5 5 0.3 0.7
0004-02 PG 13.5 5 0.3 0.7
0004-03 PG 13.5 5 0.3 0.7
0004-04 PG 13.5 5 0.3 0.7
0004-05 PG 13.5 5 0.3 0.7
0004-06 PG 13.5 5 0.3 0.7


Thanks

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