Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 10-15-2017, 10:29 AM
GWTJR GWTJR is offline Find currency amounts in Word doc, perform sum Windows 10 Find currency amounts in Word doc, perform sum Office 2013
Novice
Find currency amounts in Word doc, perform sum
 
Join Date: Oct 2017
Posts: 2
GWTJR is on a distinguished road
Default Find currency amounts in Word doc, perform sum

Dear Experts,
I have a requirement for a VBA macro and I am stumped! Here are the (deceptively simple) steps involved:

1. Find currency amounts in a Word document. Currency amounts appear in the following format: EUR 20.3m (meaning 20.3 million euros)
2. Extract only the numerical portion of the find string.
3. Perform a sum of all amounts found.

Background: Typically there are around 30-40 amounts to add up in a given document. The current method involves copying and pasting each amount manually into an Excel spreadsheet, then performing an auto sum. Obviously this consumes a large amount of time and needs to be automated if possible.

With that in mind I attempted to write up some VBA code to automate the above steps. I first tried initiating the macro from Word. Below is my poorly-written code:

Code:
Sub FindCopyPasteWordToExcel()

    Dim oXL As Excel.Application
    Dim oWB As Excel.Workbook
    Dim WorkbookToWorkOn As String
    
    'Specify the workbook to work on
    WorkbookToWorkOn = "C:\Users\ ... \Book1.xlsm"
    
    ' Open the workbook
    Set oWB = oXL.Workbooks.Open(FileName:=WorkbookToWorkOn)
    
    With ActiveDocument.Range = wdWholeStory
    
        Selection.HomeKey
        Do
            With Selection.Find
                .ClearFormatting
                .Text = "(EUR )(*)(m)"
                .Replacement.Text = "\2"
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchAllWordForms = False
                .MatchSoundsLike = False
                .MatchWildcards = True
            End With
            Selection.Find.Execute Replace:=wdReplaceAll
                
            If .Found = True Then
                Selection.Copy
                oXL.ActiveSheet.Range("B1:B40").FindNext.Select
                oXL.ActiveCell.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False
                oXL.ActiveWorkbook.Save
                oXL.ActiveWorkbook.Close
            Else
                MsgBox "No items were found."
            End If
        Loop Until ActiveDocument.Range.End
    End With
End Sub
The result in Excel was: only the first found instance of an amount was pasted into cell B2. The pasted result was "EUR 20.3m".

I next attempted to initiate the code in Excel, but I ended up stumped at the same result. Clearly I made the same mistakes in that code, so no need to add it.



I'm looking forward to hearing your feedback and suggestions. Thank you in advance for your time!
Reply With Quote
  #2  
Old 10-15-2017, 01:38 PM
macropod's Avatar
macropod macropod is offline Find currency amounts in Word doc, perform sum Windows 7 64bit Find currency amounts in Word doc, perform sum Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,213
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 Demo()
Application.ScreenUpdating = False
Dim Amt As Single
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "EUR [0-9.]@m"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    Amt = Amt + CSng(Split(Split(.Text, " ")(1), "m")(0))
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
MsgBox "EUR " & Amt & "m"
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #3  
Old 10-15-2017, 02:18 PM
GWTJR GWTJR is offline Find currency amounts in Word doc, perform sum Windows 10 Find currency amounts in Word doc, perform sum Office 2013
Novice
Find currency amounts in Word doc, perform sum
 
Join Date: Oct 2017
Posts: 2
GWTJR is on a distinguished road
Default

BRILLIANT! Thank you Paul. One day when you're bored, I'd love to get a better understanding of the .Find.Found loop. That's the key to understanding how to use the find results and manipulate the data as needed. Very much appreciated.
Reply With Quote
  #4  
Old 10-15-2017, 02:22 PM
macropod's Avatar
macropod macropod is offline Find currency amounts in Word doc, perform sum Windows 7 64bit Find currency amounts in Word doc, perform sum Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,213
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 .Find.Found simply returns True or False depending on whether the Find expression has been found. Putting it in a loop with:
.Collapse wdCollapseEnd
.Find.Execute
Simply causes Word to keep looking for more hits until .Find.Found returns False.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Find currency amounts in Word doc, perform sum How do I create currency cells in a Word Table DelHop Word Tables 11 11-24-2019 02:37 PM
Adding addresses and $ amounts to Word docs littlepeaks Word VBA 2 01-22-2016 07:57 PM
Macro to find a word in first row of table and then perform two macros hmsrose Word VBA 5 01-30-2015 12:17 AM
Find currency amounts in Word doc, perform sum Perform a search for alternative words jungkim Word 2 03-24-2012 07:40 AM
Find currency amounts in Word doc, perform sum Perform Calculations using List boxes Jennifer_Falcon Word VBA 6 07-26-2011 10:49 AM

Other Forums: Access Forums - Senior Forums

All times are GMT -7. The time now is 06:40 AM.


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