Cut and paste by reference part 2

[Lunks]

As you can see on another thread, I had some problems making some cells
being cut down to another row.
(thread:
http://groups.google.com/group/micr...read/thread/1decec403728509b/b1ecc6f058e0f01e)

Tom Ogilvy did a pretty nice job and made a script that did everything
I needed.

But now I need something else. I want to break more than one line,
like:

P|00000|ICMS|IPI|T|123|999|T|123|456
P|00001|ABCD|ASD|T|456|666|T|888|4456
P|00002|LINK|LUNK|T|789|333 |T|321|3214

Would become:

P|00000|ICMS|IPI
T|123|999
T|123|456
P|00001|ABCD|ASD
T|456|666
T|888|4456
P|00002|LINK|LUNK
T|789|333
T|321|3214

A proposal would be that every cell with just a "T" would be triggered
a new row.
Remembering that each "|" means a cell divider.

Thanks in advance specially to Tom Ogilvy, which did a great job.

 

[Dave Peterson]

Can you just break it at column E and column H?

Option Explicit
Sub DDDD2()
Dim i As Long
Dim lastrow As Long
Dim rng As Range
lastrow = Cells(Rows.Count, 1 _
).End(xlUp).Row
For i = lastrow + 1 To 2 Step -1
Set rng = Cells(i - 1, 1)
Rows(i).Resize(2).Insert
Cells(i - 1, 5).Resize(1, 3).Copy Cells(i, 1)
Cells(i - 1, 8).Resize(1, 3).Copy Cells(i + 1, 1)
Cells(i - 1, 5).Resize(1, 6).ClearContents
Next
End Sub

 

[Lunks]

I can't break on an exact column because it won't always be one or two
new rows. It'll vary on each line.
This is for using data from my old db (which was in DBF) to a new one
in SQL. It has an import layout, which has to follow this template.
As I get this data from Access, I get all of them in a single line.

If I have one product which costs 10 pounds and has a 5% vat (in Brazil
it's not vat, but some other taxes), I'd have to make something like
this:

P|Product Name|Product Code|10.00
T|VAT|5

On some products I won't have any taxes, on some I'll have more than
one, and this would be interpreted as long as it has a "T" below any
"P" lines. Note that "P" means we started to show info about a product,
and until another new row starting with a "P", It'll be info from the
same product.

So, a better method would be insert a new row if there's a single "T"
and, until another single "T" shows up, it'll all be on the same row.

 

[Dave Peterson]

Maybe...

Option Explicit
Sub DDDD2()
Dim iRow As Long
Dim LastRow As Long
Dim NumberOfTs As Long
Dim iCol As Long
Dim oRow As Long
Dim oCol As Long
Dim FoundFirstTCol As Long

With ActiveSheet
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For iRow = LastRow To 2 Step -1
FoundFirstTCol = 0
NumberOfTs = Application.CountIf(.Rows(iRow) _
.Resize(1, .Columns.Count - 1).Offset(0, 1),
"T")
If NumberOfTs > 0 Then
.Rows(iRow + 1).Resize(NumberOfTs).Insert
oRow = iRow
oCol = 1
For iCol = 2 To _
.Cells(iRow, .Columns.Count).End(xlToLeft).Column
If UCase(.Cells(iRow, iCol).Value) = "T" Then
If FoundFirstTCol = 0 Then
FoundFirstTCol = iCol
End If
oRow = oRow + 1
oCol = 1
Else
oCol = oCol + 1
End If
If FoundFirstTCol <> 0 Then
.Cells(oRow, oCol).Value = .Cells(iRow, iCol).Value
End If
Next iCol
End If
If FoundFirstTCol > 0 Then
.Range(.Cells(iRow, FoundFirstTCol), _
.Cells(iRow, .Columns.Count)).ClearContents
End If
Next iRow
End With
End Sub

 

[Lunks]

I get a syntax error at:

NumberOfTs = Application.CountIf(.Rows(iRow) _
.Resize(1, .Columns.Count - 1).Offset(0,
1),
"T")

 

[Dave Peterson]

Sorry, the line was too long:

NumberOfTs = Application.CountIf(.Rows(iRow) _
.Resize(1, .Columns.Count - 1).Offset(0, 1), "T")

 

[Lunks]

It works!
But for some reason, it only runs on the last row, not on all of them.

 

[Dave Peterson]

I put this in A2:J4 (headers in row 1):

P 0 ICMS IPI T 123 999 T 123 456
P 1 ABCD ASD T 456 666 T 888 4456
P 2 LINK LUNK T 789 333 T 321 3214

And ran that macro.

I ended up with this in A210

P 0 ICMS IPI
T 123 999
T 123 456
P 1 ABCD ASD
T 456 666
T 888 4456
P 2 LINK LUNK
T 789 333
T 321 3214

 

[Lunks]

P|1|LALA|2|T|44
P|LA|ROCK|1|T|1|2
after the macro became:
P|1|LALA|2|T|44
P|LA|ROCK|1
T|1|2

 

[Dave Peterson]

The code avoids the top row.

change this
For iRow = LastRow To 2 Step -1
to
For iRow = LastRow To 1 Step -1

if you want row 1 included.

 

[Lunks]

Thanks, it works!
I'm really glad.

Thanks for your help!

 

[Dave Peterson]

Glad you got it working.

Thanks, it works!
I'm really glad.

Thanks for your help!