Needing Help on Copying to next row (1 Viewer)

[cfp76]

First, using Excel 2010.

Second, the raw data I'm looking at is similar to this:

0001 AUT123
0002 LIF654 LIF987
0003 AUT985 LIF456

The output I want is for all LIF elements to be reported in a nice table like this:
0002 LIF654
0002 LIF987
0003 LIF456

As you can see, the first one was skipped because it does not have LIF. The second is supposed to report on 2 different rows, splitting the two LIF values. The third reports the 2nd element....

Currently, this is the code I have in my macro:

Sub LifeOnly1()
'
' LifeOnly1 Macro
'

'
'n = active cell offset
'a = offset for copying customer information for each policy

Dim n As Integer
Dim a As Integer
Sheets("LifeOnly").Select
Range("A2:AK1000000").Clear
Range("A2").Select
Sheets("CSVImport").Select
Range("A2").Select

n = 10

FindLif:

If Left(ActiveCell.Offset(0, n), 3) = "LIF" Then
'Client Reference Copy
a = 0
ActiveCell.Offset(0, a).Copy
Sheets("LifeOnly").Select
ActiveCell.Offset(0, a).PasteSpecial

'Copy remainder of Customer Information
Do Until a = 8
a = a + 1
Sheets("CSVImport").Select
ActiveCell.Offset(0, a).Copy
Sheets("LifeOnly").Select
ActiveCell.Offset(0, 1).PasteSpecial
Loop

'Copy Active Remit Cell into LifeOnly
Sheets("CSVImport").Select
ActiveCell.Offset(0, n).Copy
Sheets("LifeOnly").Select
ActiveCell.Offset(0, 1).PasteSpecial
End If

n = n + 2
Sheets("CSVImport").Select

If ActiveCell.Offset(0, n) = Empty Then
ActiveCell.Offset(1, 0).Activate
If ActiveCell.Offset(0, 0) = Empty Then
GoTo EndLoop
End If
GoTo FindLif
End If



EndLoop:
Sheets("LifeOnly").Select
End Sub

What it is doing is that it picks up the first LIF for 0002 and puts it in BUT THEN it overwrites that with the second LIF for 0002 - it needs to shift down to the next row and copy it over but its not working.

Help :/

 

[Brianwarnock]

I would not use activecell approach, I would address the cells using the Cells(rowindex, colindex) method and then you can just increase rhe rowindex as required

Sheets("lifeonly").Cells(r,1)

Dim r as long and set it to 2 then just add1 after ever paste

Brian

 

[cfp76]

Its saying on the line Sheets("LifeOnly").Cells(r,1) that there is an expected =

...

 

[Brianwarnock]

Sorry I havent time to do the full code but you are building a loop along the lines of

Dim r As Long, rc As Long, cc As Long
r = 2       ' these represent the starting rows for the copy and paste and the     starting column for the copy
cc = 1
Do
Sheets("Csvimport").Cells(rc, cc).Copy
Sheets("Lifeonly").Cells(r, 1).PasteSpecial
cc=cc+1
if Sheets("Csvimport").Cells(rc, cc) is empty
cc = 1
rc = rc+1    ' move down a row
end if
if Sheets("Csvimport").Cells(rc, cc) is empty
go to endloop   
end if
r = r + 1
Loop

The use of SELECT causes the worksheet to be continually referenced and thus is inefficient.