Can somebody help me with a macro to move a line two lines down?

Pallantir · #1 11-12-2023, 08:58 AM

I have to do some 20-30 page documents regularly, and they look like this (Norwegian text, but the main thing is "nøkkelord", which means "keyword" and is the same every time, plus a number (which is not a sequence):

Code:

nøkkelord 3
Det var en gange en nisse
som måtte tisse

Han hoppet over et gjerde,
der fant han ei pære

nøkkelord 2
den delte han i fem,
én, to, tre, fire, fem

So the keyword and the number isn't in all groups, but when it's there, I need it moved down so it ends up like this:

Code:

Det var en gange en nisse
som måtte tisse
nøkkelord 3

Han hoppet over et gjerde,
der fant han ei pære

den delte han i fem,
én, to, tre, fire, fem
nøkkelord 2

And that has to loop until the end of the document, so it takes all instances of this.

My boss is to cheap to get us anything newer than Office 2007, and it works for what we need it to do, so that's the format for it.

I have searched the web and this forum for hours this weekend, but I haven't found anything that works this way. Could somebody please help me out?

vivka · #2 11-12-2023, 12:00 PM

Hi! It's quite simple:

Code:

Sub Move_Two_Lines_Down()

Dim Rng As range

Set Rng = selection.range

Application.ScreenUpdating = False

    Do
        With Rng.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .text = "Keywords ^#"
            .Forward = True
            .Format = True
            .Wrap = wdFindStop
            .MatchWildcards = False
            .Execute
            If Rng.End > selection.range.End Then Exit Do
            If .found Then
                Rng.Paragraphs(1).range.Cut
                Rng.Move unit:=wdParagraph, count:=2
                Rng.Paste
                Rng.Collapse wdCollapseEnd
            Else: Exit Do
            End If
        End With
    Loop
Application.ScreenUpdating = True
Set Rng = Nothing
End Sub

Replace 'Keywords' with your word. If you want to work on the whole doc either press Ctrl+A or replace 'selection.range' with 'ActiveDocument.range'.

Pallantir · #3 11-13-2023, 01:19 AM

Thank you very much, vivka! I guess it's like almost everything else in the world, it's easy if you know it!

I could for some reason not get ActiveDocument.range to work, but I added a Selection.WholeStory above the sub, and that worked. It's actually a part of a larger macro, but that didn't give me any problems, using WordBasic.StartOfDocument as the line under this part of the macro made it go without a hich.

gmaxey · #4 11-13-2023, 06:23 AM

It seems that Vivka's code misses the last instance of your keyword. I also don't understand the reason for the If .found condition. You might try:

Code:

Sub Move_Two_Lines_Down()
Dim oRng As Range
  Set oRng = ActiveDocument.Range
  Application.ScreenUpdating = False
  With oRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "Keywords ^#"
    .Forward = True
    .Format = True
    .Wrap = wdFindStop
    While .Execute
      oRng.Paragraphs(1).Range.Cut
      oRng.Move unit:=wdParagraph, Count:=2
      oRng.Paste
      If oRng.End = ActiveDocument.Range.End - 1 Then
        oRng.InsertBefore vbCr
        oRng.Paragraphs.Last.Next.Range.Delete
      End If
       oRng.Collapse wdCollapseEnd
    Wend
  End With
  Application.ScreenUpdating = True
lblExit:
  Set oRng = Nothing
  Exit Sub
End Sub

Pallantir · #5 11-14-2023, 11:25 AM

Thank you! I will try that!

Edit: It works too!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
1st line of 4-line poem centrally aligned; how to get lines 2-4 to start at same location on page	Swarup	Word	6	09-16-2022 11:07 AM
I need a macro to move dangling words to a new line please	iNeedaMacroPlease	Word VBA	2	11-27-2020 11:34 AM
How to move a line to another line that starts with a chain selected in the 1st one?	gloub	Word VBA	24	03-19-2019 03:12 PM
Lock line so text does not move to next line	saundrals	Word	2	06-19-2014 03:59 PM
Lines move between close and open	jsmath22	PowerPoint	0	12-15-2010 07:44 AM