Loop Within Loop... Sometimes

[CFitz]

I currently have a loop that pulls data out of a horribly formatted report
and places it into column B without any blank cells between each client. I
have a second loop that pulls a momentary amount of the same report. They
are both below.

Sub pullclient()
Dim roe As Long
Dim roe2 As Long

roe = 1
roe2 = 2

Do Until Sheet1.Cells(roe, 1).Value Like "*END OF REPORT*"
If Sheet1.Cells(roe, 1).Value Like "*CLIENT: *" Then
x = InStr(Sheet1.Cells(roe, 1).Value, "CLIENT: ")
Sheet1.Cells(roe2, 2) = Mid(Sheet1.Cells(roe, 1).Value, x + 9, 6)
roe2 = roe2 + 1
End If
roe = roe + 1
Loop

End Sub

Sub pullagency()
Dim roe As Long
Dim roe2 As Long

roe = 1
roe2 = 2

Do Until Sheet1.Cells(roe, 1).Value Like "*END OF REPORT*"
If Sheet1.Cells(roe, 1).Value Like "*Paid Direct*" Then
Sheet1.Cells(roe2, 3) = Trim(Right(Sheet1.Cells(roe, 1), 10))
roe2 = roe2 + 1
End If
roe = roe + 1
Loop
End Sub

Basic Report Format

kdjflajdCLIENT: lfjasdlfjaf
oiuoiu
df Paid Direct lkjdfas
dfa
CLIENT: fdkfjadf
dflja
qoruo
CLIENT: ljlfkjadsf

The problem that arises is that it will find the a viable client number 2000
times. It will only find the monetary amount 1800 times. When it moves the
information into columns B & C they don't necessarily match up. As shown
above there isn't always a Paid Direct amount after each Client. What I need
to happen is that after it finds the Client it loops till it finds a Paid
Direct amount and move it or stops when it finds another set of Client
information.

Hope that makes sense.

Thanks
Chris

 

[Don Guillett]

It would be nice to see a before/after example. If paid direct exists AND is
it ALWAYS 2 rows down. If desired, send your wb to my address below and I
will take a look. Give a clear explanation and examples.

 

[Dave Peterson]

Maybe...
Option Explicit
Sub PullClientAndAgency()

Dim iRow As Long
Dim oRow As Long
Dim ClientPos As Long
Dim AgencyPos As Long

oRow = 1
With Sheet1
For iRow = 1 To .Cells(.Rows.Count, "a").End(xlUp).Row
ClientPos _
= InStr(1, .Cells(iRow, "A").Value, "CLIENT: ", vbTextCompare)
If ClientPos = 0 Then
'skip this record
Else
'on a new "record"
oRow = oRow + 1
.Cells(oRow, "b").Value _
= Mid(.Cells(iRow, "A").Value, ClientPos + 9, 6)
.Cells(oRow, "D").Value = iRow 'just for testing
End If
AgencyPos = InStr(1, .Cells(iRow, "A").Value, _
"Paid Direct ", vbTextCompare)
If AgencyPos = 0 Then
'skip this record
Else
.Cells(oRow, "C").Value = Mid(.Cells(iRow, "A").Value, _
AgencyPos + Len("paid direct "))
.Cells(oRow, "E").Value = iRow 'still for testing
End If
Next iRow
'maybe
'On Error Resume Next
'.Range("C1").EntireColumn.Cells _
' .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'On Error GoTo 0
'.range("A1").entirecolumn.delete
End With
End Sub