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