Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 09-13-2012, 10:35 AM
jperez84 jperez84 is offline Macro that can find phrase and then find another and copy Windows XP Macro that can find phrase and then find another and copy Office 2007
Novice
Macro that can find phrase and then find another and copy
 
Join Date: Sep 2012
Posts: 21
jperez84 is on a distinguished road
Default Macro that can find phrase and then find another and copy

Good afternoon,

The macro I'm trying to setup should first find a certain phrase (there will be many different ones and would like to put them all in at once), let’s say “hello there buddy”. From there it will search for another set of characters above it. Let’s say “NAM/” and it will copy that entire line (if there is a way to tell it only to copy between the first set on “//” or the second, etc is even better) . The only thing is that it’s never the same amount of characters above or lines above. From there it will copy the text into an excel spreadsheet. Also, is it possible for the macro to find "NAM/" and lets say "test" and copy both lines and put them next to each other in two separate cells? Or should a second macro be rum and just change the parameters? Below is an example of how the word doc is setup. Setup is similar to another question I posted a few days ago, but the output s different.

Thanks in advance.

^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^


test1 NAM/smith, peter/ jackson, Samantha/
123
test
unneeded info
hello there buddy

^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
test2 NAM/jones,Jeffrey/ sandler,adam/
356
another
test
can you
believe it
I can’t
hello there buddy
Reply With Quote
  #2  
Old 09-14-2012, 04:59 AM
macropod's Avatar
macropod macropod is offline Macro that can find phrase and then find another and copy Windows 7 64bit Macro that can find phrase and then find another and copy Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,232
macropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant future
Default

For the most part, the Find process is much the same as in your other post. However, if you're both looking for multiple primary strings (eg 'hello there buddy|monday morning') and multiple secondary strings (eg NAM|ID) at the same time, that could make things complicated. As for populating Excel, that's quite doable but could end up accounting for 80% of the final code. Do you already have the Excel workbook the data are to go in, or is the macro to create a new one?
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #3  
Old 09-14-2012, 06:10 AM
jperez84 jperez84 is offline Macro that can find phrase and then find another and copy Windows XP Macro that can find phrase and then find another and copy Office 2007
Novice
Macro that can find phrase and then find another and copy
 
Join Date: Sep 2012
Posts: 21
jperez84 is on a distinguished road
Default

The macro is to create a new one. The cells where the data needs to go might change. Will it be easy for me to be able to change the cells in the macro?I don't know if its possible or if this would work period but could the macro find the first phrase "hello there buddy" then look above to find the first secondary string "NAM". Then copy paste and then return to the first phrase and look above again for this time the second secondary string "ID" copy, paste. Then it will move to the second phrase. Thanks for your help.
Reply With Quote
  #4  
Old 09-14-2012, 08:07 PM
macropod's Avatar
macropod macropod is offline Macro that can find phrase and then find another and copy Windows 7 64bit Macro that can find phrase and then find another and copy Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,232
macropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant future
Default

Try:
Code:
Sub DataExtract()
Application.ScreenUpdating = False
Dim StrPri As String, StrSec As String, StrTmp As String, StrTxt As String, StrOut As String
Dim i As Long, j As Long, x As Long
StrPri = InputBox("What is the Primary Text Array to Find?" _
  & vbCr & "Use the '|' character to separate array elements.")
If Trim(StrPri) = "" Then Exit Sub
StrSec = InputBox("What is the Secondary Text Array to Find?" _
  & vbCr & "Use the '|' character to separate array elements.")
If Trim(StrSec) = "" Then Exit Sub
With ActiveDocument.Range
  x = .End
  'Find text blocks bounded by caret (^) symbols
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^94[!^94]"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found = True
    With .Duplicate
      .Start = .Start + 1
      .MoveEndUntil Cset:="^", Count:=wdForward
      'Within each found block, check for a primary extraction string
      For i = 0 To UBound(Split(StrPri, "|"))
        'If found, look for a secondary string
        If InStr(.Text, Split(StrPri, "|")(i)) > 0 Then
          For j = 0 To UBound(Split(StrSec, "|"))
            If InStr(.Text, Split(StrSec, "|")(j)) > 0 Then
              'Extract the text on the secondary string's line
              StrTmp = Split(.Text, Split(StrSec, "|")(j))(1)
              StrTmp = Split(StrTmp, vbCr)(0)
              StrOut = StrOut & vbCr & StrTmp
            End If
          Next
          Exit For
        End If
      Next
      If .End = x Then Exit Do
    End With
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
  'Clean up the output string, removing unwanted spaces and capitalising words
  StrTmp = StrOut
  StrOut = ""
  For i = 0 To UBound(Split(StrTmp, "/"))
    For j = 0 To UBound(Split(Trim(Split(StrTmp, "/")(i)), ","))
      StrTxt = Trim(Split(Trim(Split(StrTmp, "/")(i)), ",")(j))
      StrOut = StrOut & UCase(Left(StrTxt, 1)) & Right(StrTxt, Len(StrTxt) - 1) & ","
    Next
    StrOut = Left(StrOut, Len(StrOut) - 1) & "/"
  Next
End With
If StrOut = "" Then Exit Sub
Call ExcelOutput(StrOut)
Application.ScreenUpdating = True
End Sub
 
Sub ExcelOutput(StrIn As String)
Dim xlApp As Object, xlWkBk As Object, xlWkSht As Object
Dim StrTmp As String, i As Long, j As Long
'Start a new Excel session
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
  MsgBox "Can't start Excel.", vbExclamation
  Exit Sub
End If
Set xlWkBk = xlApp.Workbooks.Add
' Ppopulate the workbook, with one row per line and
' separate columns for each /-delineated 'field'
With xlWkBk.Worksheets(1)
  For i = 0 To UBound(Split(StrIn, vbCr))
    StrTmp = Split(StrIn, vbCr)(i)
    For j = 0 To UBound(Split(StrTmp, "/")) - 1
      If Split(StrTmp, "/")(j) <> "" Then
        .Cells(i, j).Value = Split(StrTmp, "/")(j)
      End If
    Next
  Next
End With
'Show the Excel workbook
xlApp.Visible = True
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
End Sub
As the code doesn't have to do any of the work associated with an existing workbook, the Excel part can be much simpler than otherwise.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #5  
Old 09-18-2012, 03:26 PM
jperez84 jperez84 is offline Macro that can find phrase and then find another and copy Windows XP Macro that can find phrase and then find another and copy Office 2007
Novice
Macro that can find phrase and then find another and copy
 
Join Date: Sep 2012
Posts: 21
jperez84 is on a distinguished road
Default

Hey Macropod,

This macro also isn't working for me. it goes through the process but Excel never opens. You said that it's easier if I already have an Excel doc open. Can we modify the current macro? Also, I'm trying to learn the coding aspect and have some other ideas for the macro. I'm thinking of making it find additional lines of text. Is the code below correct?

Code:
StrSec = InputBox("What is the Third Text Array to Find?" _
  & vbCr & "Use the '|' character to separate array elements.")
If Trim(StrThrd) = "" Then Exit Sub
Code:
If InStr(.Text, Split(StrPri, "|")(k)) > 0 Then
          For j = 0 To UBound(Split(StrThrd, "|"))
            If InStr(.Text, Split(StrThrd, "|")(k)) > 0 Then
              'Extract the text on the third string's line
              StrTmp = Split(.Text, Split(StrThrd, "|")(k))(1)
              StrTmp = Split(StrTmp, vbCr)(0)
              StrOut = StrOut & vbCr & StrTmp
            End If
          Next
          Exit For
        End If
I don't know how to do the Excel portion though. Also, If instead of an input box we can have it read from a list I think that would work better.

Thanks for your help.
Reply With Quote
  #6  
Old 09-18-2012, 03:50 PM
macropod's Avatar
macropod macropod is offline Macro that can find phrase and then find another and copy Windows 7 64bit Macro that can find phrase and then find another and copy Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,232
macropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant future
Default

The code works fine in my testing. The Excel workbook will only be created if something has been found. As mentioned in the other thread, the searches are case-sensitive.
Quote:
You said that it's easier if I already have an Excel doc open.
I think you have misunderstood what I said. If the workbook is supposed to exist already, a lot more coding is required, including code to test whether the workbook is already opened.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #7  
Old 09-18-2012, 04:37 PM
jperez84 jperez84 is offline Macro that can find phrase and then find another and copy Windows XP Macro that can find phrase and then find another and copy Office 2007
Novice
Macro that can find phrase and then find another and copy
 
Join Date: Sep 2012
Posts: 21
jperez84 is on a distinguished road
Default

That's whats weird. I first did a find in the doc to make sure that what is being searched for is actually in the doc and it is. Did my code look right?
Reply With Quote
  #8  
Old 09-18-2012, 04:49 PM
macropod's Avatar
macropod macropod is offline Macro that can find phrase and then find another and copy Windows 7 64bit Macro that can find phrase and then find another and copy Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,232
macropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant future
Default

You don't need your version of 'StrSec'. The code I posted will already find multiple secondary expressions for each primary string. It also looks to me like your revision would simply overwrite the StrSec that's already in use.

Have you actually tried the code as I posted it? As I said, it works fine in my testing - with multiple primary and secondary strings.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #9  
Old 09-18-2012, 04:59 PM
jperez84 jperez84 is offline Macro that can find phrase and then find another and copy Windows XP Macro that can find phrase and then find another and copy Office 2007
Novice
Macro that can find phrase and then find another and copy
 
Join Date: Sep 2012
Posts: 21
jperez84 is on a distinguished road
Default

Yes, I tried it how you posted it. I'm going to retry it tomorrow and check to make sure its case sensitive. For this macro it would also help to be able to feed it a list for the first search string because they add up to more than 256 characters.

So, for the searches, if my primary search is DIN/A123456789|DIN/987654 and my secondary is NAM|ID|.QW ., the three secondaries will be searched for each primary. Thanks.
Reply With Quote
  #10  
Old 09-19-2012, 08:59 AM
jperez84 jperez84 is offline Macro that can find phrase and then find another and copy Windows XP Macro that can find phrase and then find another and copy Office 2007
Novice
Macro that can find phrase and then find another and copy
 
Join Date: Sep 2012
Posts: 21
jperez84 is on a distinguished road
Default

Ok, I tested it again and no luck. The macro runs and I get no errors, but Excel doesn't open.
Reply With Quote
  #11  
Old 09-19-2012, 04:48 PM
macropod's Avatar
macropod macropod is offline Macro that can find phrase and then find another and copy Windows 7 64bit Macro that can find phrase and then find another and copy Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,232
macropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant future
Default

Assuming the data errors you discovered in the other thread are the issue for this one also, try the following:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim wdDoc As Document, i As Long, j As Long, k As Long
Dim StrPri As String, StrSec As String, StrTmp As String, StrTxt As String, StrOut As String
StrSec = InputBox("What is the Secondary Text Array to Find?" _
  & vbCr & "Use the '|' character to separate array elements.")
If Trim(StrSec) = "" Then Exit Sub
Set wdDoc = Documents.Open(File:="Drive:\FilePath\SearchList.doc", Visible:=False, AddToRecentFiles:=False)
StrPri = Replace(wdDoc.Range.Text, vbLf, vbCr)
wdDoc.Close False
Set wdDoc = Nothing
While InStr(StrPri, vbCr & vbCr) > 0
  strFnd = Replace(StrPri, vbCr & vbCr, vbCr)
Wend
StrPri = Left(StrPri, Len(StrPri) - 1)
With ActiveDocument.Range
  j = .End
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^94[!^94]"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found = True
    With .Duplicate
      .Start = .Start + 1
      .MoveEndUntil Cset:="^", Count:=wdForward
      'Within each found block, check for a primary extraction string
      For i = 0 To UBound(Split(StrPri, vbCr))
        'If found, look for all the secondary strings
        If InStr(.Text, Split(StrPri, vbCr)(i)) > 0 Then
          For j = 0 To UBound(Split(StrSec, "|"))
            If InStr(.Text, Split(StrSec, "|")(j)) > 0 Then
              'Extract the text on the secondary string's line
              StrTmp = Split(.Text, Split(StrSec, "|")(j))(1)
              StrTmp = Split(StrTmp, vbCr)(0)
              StrOut = StrOut & vbCr & StrTmp
            End If
          Next
          Exit For
        End If
      Next
      If .End = x Then Exit Do
    End With
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
  'Clean up the output string, removing unwanted spaces and capitalising words
  StrTmp = StrOut
  StrOut = ""
  For i = 0 To UBound(Split(StrTmp, "/"))
    For j = 0 To UBound(Split(Trim(Split(StrTmp, "/")(i)), ","))
      StrTxt = Trim(Split(Trim(Split(StrTmp, "/")(i)), ",")(j))
      StrOut = StrOut & UCase(Left(StrTxt, 1)) & Right(StrTxt, Len(StrTxt) - 1) & ","
    Next
    StrOut = Left(StrOut, Len(StrOut) - 1) & "/"
  Next
End With
If StrOut = "" Then Exit Sub
Call ExcelOutput(StrOut)
Application.ScreenUpdating = True
End Sub
 
Sub ExcelOutput(StrIn As String)
Dim xlApp As Object, xlWkBk As Object, xlWkSht As Object
Dim StrTmp As String, i As Long, j As Long
'Start a new Excel session
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
  MsgBox "Can't start Excel.", vbExclamation
  Exit Sub
End If
Set xlWkBk = xlApp.Workbooks.Add
' Ppopulate the workbook, with one row per line and
' separate columns for each /-delineated 'field'
With xlWkBk.Worksheets(1)
  For i = 0 To UBound(Split(StrIn, vbCr))
    StrTmp = Split(StrIn, vbCr)(i)
    For j = 0 To UBound(Split(StrTmp, "/")) - 1
      If Split(StrTmp, "/")(j) <> "" Then
        .Cells(i, j).Value = Split(StrTmp, "/")(j)
      End If
    Next
  Next
End With
'Show the Excel workbook
xlApp.Visible = True
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
End Sub
As with the other thread, simply create your input document with a separate line(paragraph) for each entry (no '|' characters for separators), then replace 'Drive:\FilePath\SearchList.doc' in the code with the input document's full path & name.

With the above code, you'll still be asked for the secondary string, which should be input like 'NAM|ID' (without the single quotes).
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]

Last edited by macropod; 09-20-2012 at 10:23 PM.
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Macro that can find phrase and then find another and copy Find, copy and paste into a new page jperez84 Word VBA 24 09-20-2012 11:34 AM
Trying to find and copy all headings at the same time WaltR Word 7 08-21-2012 03:12 PM
Macro that can find phrase and then find another and copy How to find exact phrase CabbageTree Outlook 2 05-14-2012 11:24 AM
Macro that can find phrase and then find another and copy Bad view when using Find and Find & Replace - Word places found string on top line paulkaye Word 4 12-06-2011 11:05 PM
Find and Replace Macro - A Better Way Tribos Word VBA 0 10-08-2008 03:22 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 04:57 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2021, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2021 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft