Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert and propagate Rows - based on a format rule
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert and propagate Rows - based on a format rule
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert and propagate Rows - based on a format rule
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert and propagate Rows - based on a format rule
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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert and propagate Rows - based on a format rule
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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert and propagate Rows - based on a format rule
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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert and propagate Rows - based on a format rule
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 |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert and propagate Rows - based on a format rule
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 |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert and propagate Rows - based on a format rule
Thanks once again for your patience Joel
No data has been written to sheet2 at my end yet Data in sheet1 has been changed, which is not anticipated I have shown the result of that by saving a sheet with that name I ran the FindProblem macro with the results contained in sheet3 Most of the problems I guess have been caused by me pasting excel data into MS Outlook Newsgroup message body ??....and the resultant spacing issues etc? I have been posting via Outlook News to msnews server I can't quite interpret your advice re changing X's to spaces and what to watch for........but maybe that won't be at the crux of the final tweaking required? I really do appreciate your solution provided......... and think its almost sussed using my data/xls workbook. I will upload my spreadsheet named "Propagate.xlsm" to your weblink given Cheers Steve aka nochain "joel" wrote in message ... 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 |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert and propagate Rows - based on a format rule
Joel
I have now had some success Data has been written to sheet2 now after I copied your latest code into a new module. When I upload the file you will see though that the data in columns B-F did not get copied/propagated. Steve |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert and propagate Rows - based on a format rule
Attachment now provided Thank you in advance SW +-------------------------------------------------------------------+ |Filename: Propagate-Routine.xlsm | |Download: http://www.thecodecage.com/forumz/attachment.php?attachmentid=404| +-------------------------------------------------------------------+ -- nochain ------------------------------------------------------------------------ nochain's Profile: 1339 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=164405 Microsoft Office Help |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
Insert and propagate Rows - based on a format rule
I didn't realize from your posting that the data was in columns A to F on sheet1. I though everything was in column A. Easy to fix. +-------------------------------------------------------------------+ |Filename: Propagate-Routine.xlsm | |Download: http://www.thecodecage.com/forumz/attachment.php?attachmentid=405| +-------------------------------------------------------------------+ -- joel ------------------------------------------------------------------------ joel's Profile: 229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=164405 Microsoft Office Help |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Create new records from existing ones based on 'rule'? | Excel Worksheet Functions | |||
insert rows based on criteria | Excel Discussion (Misc queries) | |||
insert rows based on criteria | Excel Discussion (Misc queries) | |||
Insert rows based on value per day | Excel Worksheet Functions | |||
Insert new rows based on Data in other rows | Excel Worksheet Functions |