Write contents of cell from one tab to another after .find

[Laavista]

I'm using Excel 2003. I have two tabs: AllTxt & ExtractInfo
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o> </o>
In 'Alltxt', I need to find each occurence of ***. If found, I need to write the contents of that cell into tab "ExtractInfo".
<o> </o>
The *** could be in different columns (A, B, C, or D)
<o> </o>
I'm using ".find" and it does find it. Now I need to write it to ExtractInfo, but nothing seems to be working.
<o> </o>
My code:
AllTxtLastRow is a variable (long) and does contact the last row number in tab AllTxt
ExtInfoBlankRow is a variable (long) and does contain the last row in tab ExtractedInfo
<o> </o>
strTextToFind = "~***"
<o> </o>
With Sheets("AllTxt").Range("A1":D" & AllTxtLastRow)
<o> </o>
CheckNext:
<o> </o>
Set C = .Find(strTxtToFind, LookIn:=xlValues) '(this works)
<o> </o>
If Not C is Nothing then 'finds the ***
FoundAddress = C.Address 'this is correct, e.g., $B$40
FoundRow = C.Row 'foundrow contains the correct row, e.g., 40
FoundCol = C.Column 'foundcol contains the correct col, e.g, B
<o> </o>
' ==========================<o></o>
'I'VE TRIED ABOUT 15+ THINGS, NOTHING WORKS TO WRITE THE CONTENTS INTO EXTRACTINFO TAB<o></o>
' A FEW FOLLOW<o></o>
<o></o>
'this does work--I get 'subscript out of range'<o></o>
Contents = Sheets("ExtractInfo").Cells(FoundRow,FoundCol) <o></o>
<o> </o>
'this does not work--I get Application-defined or object-defined error<o></o>
Worksheets("ExtractInfo").Range("A" & ExtInfoBlankRow, "A"). value = Worksheets("AllTxt").Range(FoundRow, FoundCol).value<o></o>
' ==============================<o></o>
<o> </o>
ActiveCell.Offset(1,0).select 'move to the next row down
ExtInfoBlankRow = ExtInfoBlankRow + 1
Goto CheckNext
<o> </o>
Else
Goto GetNextFile
end if
end with
<o> </o>
GetNextFile:
<o> </o>
<o> </o>
<o> </o>
YOUR HELP WOULD BE SO APPRECIATED!
<o> </o>
<o> </o>
<o> </o>
<o> </o>

<o> </o>
<o> </o>
<o> </o>

 

[keewhan]

does this help you out? It will look for an instance of *** and if found it will reference the cell address for later,and it will transfer the cell contents to the next avaiable row on ExtractInfo

Then it loops through the find statement checking for all instances, copying the value to the next cell on ExtractInfo by increasing ExtInfoBlankRow by one each time it find it.

Once the loop gets back to the first cell it found it jump to GetNextFile

If it finds no instance it also jump to GetNextFile (which in my code just exits the sub).

Tell me how it goes...if you need any more help let me know

Sub Find_String_Loop()

On Error GoTo GetNextFile

ExtInfoBlankRow = Sheets("ExtractInfo").Range("A1").CurrentRegion.Count + 1
    
Sheets("AllTxt").Select
    Range("A1").Select

strTxtToFind = "~***"

Cells.Find(What:=strTxtToFind, _
                    After:=ActiveCell, _
                    LookIn:=xlValues, _
                    LookAt:=xlPart, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False, _
                    SearchFormat:=False).Activate

TxtFirstAddress = ActiveCell.Address

    Sheets("ExtractInfo").Range("A" & ExtInfoBlankRow).Value = _
        Range(TxtFirstAddress).Value

ExtInfoBlankRow = ExtInfoBlankRow + 1

Do

Cells.Find(What:=strTxtToFind, _
                    After:=ActiveCell, _
                    LookIn:=xlValues, _
                    LookAt:=xlPart, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False, _
                    SearchFormat:=False).Activate

TxtLoopAddress = ActiveCell.Address
                    
If TxtLoopAddress = TxtFirstAddress Then GoTo GetNextFile

    Sheets("ExtractInfo").Range("A" & ExtInfoBlankRow).Value = _
        Range(TxtLoopAddress).Value
                    
ExtInfoBlankRow = ExtInfoBlankRow + 1

Loop

Exit Sub

GetNextFile:
Exit Sub

End Sub

 

[Laavista]

WOW--it worked the first time!

I cannot tell you how much I appreciate this. I worked on just this problem for over 2 hours and was so frustrated.

Thank you for taking the time to post this code. You are incredible!

 

[keewhan]

thats great news! thanks for letting me know it worked...

Let me know if you come up against any other 'challenges'!!

 

[Laavista]

Another question

(I hope this is not a duplicate post. I posted it last night, but I don't see it displayed...)

May I bother you once more? Your code worked perfectly, but I just found out that the line(s) following the *** line found have to be picked up and concatenated to the contents of the *** line if the following line(s) is not null or if it doesn't begin with ***. I do not know the possible number of lines following the ***, so will probably need to use an array. I've tried to incorporate this, but after hours (and hours) of trying different things, it is not working.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o> </o>
<o></o>
The scenario:<o></o>
Data example:<o></o>
<o></o>
In tab "AllTxt"<o></o>
(in cell D2) ***This is a test line<o></o>
(in cell D3) ***2nd test line<o></o>
(in cell D4) this line has to be picked up and concatenated with cell D3<o></o>
(in cell D5) this has to be picked up & concatenated with D3 & D4<o></o>
(in cell D6) ***WhosOnFirst<o></o>
(in cell D7) ***BigMac<o></o>
(in cell D8) this line has to be concatenated with D7<o></o>
(Cell 9) (blank line)<o></o>
<o></o>
Once a cell is found that starts with ***, I need to check if there are subsequent lines that go with it. If the next line is NULL or if the next line begins with ***, then I just need to write the one line to the worksheet (same as the code you gave me previously).<o></o>
<o> </o>
However, when a *** is found and the next line is not null or does not start with ***, then I need to concatenate that line with the previous, then check the same thing for the NEXT line. Is the 3rd line null or begin with ***? If yes, then check for a 4th, etc. until the next line is null or starts with an ***. The concatenated line is written to the tab 'ExtractInfo<o></o>
<o></o>
<o></o>
Pseudo code:<o></o>
Do until no more lines with ***<o></o>
In tab AllTxt:<o></o>
find line starting with ***<o></o>
Check next line<o></o>
If null or contents begins with ***, write contents of line to ExtractInfo tab<o></o>
Find next line with ***<o></o>
<o></o>
<o> </o>
If not null or contents do not begin with *** then:<o></o>
do until line is blank or line begins with ***<o></o>
check next line<o></o>
If NOT null or contents does not begin with ***, then <o></o>
concatenate this line to previous line(s)<o></o>
loop<o></o>
<o></o>
========= <o></o>
For the data listed above, the results would be:
<o> </o>
The following line would be written in the ExtractInfo tab<o></o>
***This is a test line (e.g., written in cell E2)<o></o>
<o> </o>
The following line would be written in the ExtractInfo tab<o></o>
***2nd test line this line has to be picked up and concatenated with cell D3 this has to be picked up & concatenated with D3 & D4 (e.g., written in cell E3)<o></o>
<o> </o>
The following line would be written in the ExtractInfo tab<o></o>
***WhosOnFirst (e.g., written in cell E4)
<o> </o>
The following line would be written in the ExtractInfo tab<o></o>
***BigMac this line has to be concatenated with D7 (e.g., written in cell E5)<o></o>
<o> </o>
If you could help, I'd REALLY appreciate it.<o></o>
<o> </o>
Thanks!<o></o>
<o> </o>