View Single Post
  #8   Report Post  
Posted to microsoft.public.excel.programming
joel[_381_] joel[_381_] is offline
external usenet poster
 
Posts: 1
Default 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