#1
|
|||
|
|||
VBA find word and create numbered list under it
I work in a clinic and editing progress notes takes a huge chunk of time. I have already wrote a macro to do most of what I want it to do. The only thing left is to add numbers to each line under the Assessment paragraph.
Before (Data) Assessment Hypertension controlled Hyperlipidemia Diabetes Mellitus IDDM Diagnosis (More data) After (Data) Assessment 1. Hypertension controlled 2. Hyperlipidemia 3. Diabetes Mellitus IDDM Diagnosis (More data) So the goal is to find the word Assessment and create a numbered list of everything under it. There is a paragraph enter before Assessment. There is a paragraph enter before Diabgnosis. Paragraph enter code I used is ^p. If you could help me out, it would be awesome. My knowledge in VBA excel is extensive; however, VBA word is another world. |
#2
|
||||
|
||||
Assuming it appears only once in the document, and each line of your assessment is terminated with a paragraph break and not a line break then
Code:
Dim orng As Range Set orng = ActiveDocument.Range With orng .Start = .Start + InStr(orng, "Assessment") .MoveStart wdParagraph .End = .Start + InStr(orng, "Diagnosis") - 2 .Style = "List Number" End With Set orng = Nothing
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
|||
|
|||
Still not working
Thank for the attempt. The data that goes into this word document has hidden codes embedded that have given me issues with a lot of the coding I've done previously to this Assessments issue. I believe your code works; However, not for my purposes. The white space codes within the document are not standard and I cannot find them anywhere online to help me delete them. I believe these white spaces are causing an inaccurate word count. When I select Assessment and everything above it, I count 8369 characters. When I run the code you provided, it counts Assessment at 8535 over .Start and then 8561 over .MoveStart. This makes my data look like this...
1. Data 2. Data 3. Data 4. 5. Assessment 6. Data 7. Data 8. Data Can you write me code that can do this... assessmentLine = ??? 'Find the line number with the word Assessment: followed by a paragraph enter ^p. i = assessmentLine + 1 'Assign line increment and start location. c = 1 'Numbered list starts with 1 then increments in loop Do Until myLine(i) = "" 'Loop until it finds a blank line. myLine(i) = c & ". " & myLine(i) '1. Hypertension would be the first output. c = c + 1 i = i + 1Loop I'm sure you programmers can understand the concept of the above. |
#4
|
||||
|
||||
Let us see a sample document (you can change any details that would identify the patient).
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#5
|
|||
|
|||
Attachment file
Attached is a fake progress note. The macro that I run is called mainMacro. All other macros are called from the mainMacro. I did not assign a shortcut key to run the macro, so you will have to open up the Editor to run it. When you run the code for the first time, it will do a lot of things that you really don't need to worry about because everything works. Just scroll down close to the bottom and locate Assessment:. That is where I need those things to be numbered.
|
#6
|
||||
|
||||
The original macro worked, but not 100% reliably. The following should do the job and you can call it from your main macro before the message box at the end.
Code:
Sub NumberSection() Dim orng As Range Set orng = ActiveDocument.Range With orng.Find Do While .Execute(FindText:="Assessment:") With orng .End = ActiveDocument.Range.End .End = .Start + InStr(orng, "Diagnosis:") - 2 .MoveStart wdParagraph .ListFormat.ApplyListTemplateWithLevel _ ListTemplate:=ListGalleries(wdNumberGallery).ListTemplates(1) .ParagraphFormat.LeftIndent = CentimetersToPoints(0) .ParagraphFormat.FirstLineIndent = CentimetersToPoints(0) .ParagraphFormat.TabStops.Add _ Position:=CentimetersToPoints(0.5), _ Alignment:=wdAlignTabLeft, _ Leader:=wdTabLeaderSpaces End With Exit Do Loop End With lbl_Exit: Set orng = Nothing Exit Sub End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#7
|
|||
|
|||
Solved
Thank you very much. It works like a charm. I even ran the macro twice to make sure it didn't undo the number list the second time it ran and it didn't. It was a big help. It may seem like something small but it takes me like 30 seconds to locate and manually number these things. 30 seconds per note and I do like 30 notes per day, that's 15 minutes you saved me each day. On top of what else my macro does, I expect the manual editing process to now take me about 3 minutes where as before it took 10 minutes. Thank you for your help.
SOLVED |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
First Item in a Word numbered list indents | ernief | Word | 2 | 09-15-2019 06:07 PM |
How to create a decimal point after each number in a numbered list in excel | wondermuse | Excel | 1 | 03-06-2017 03:42 AM |
Word 2016 - Numbered List | jthomas666 | Word | 2 | 06-16-2016 12:08 PM |
Word Mixing Numbered Headings with Numbered List | Tess0 | Word | 11 | 07-15-2014 05:25 AM |
How to create a automatically numbered list? | three_jeeps | Word | 3 | 05-30-2013 10:53 AM |