Quantcast
Channel: Active questions tagged excel - Stack Overflow
Viewing all articles
Browse latest Browse all 88029

For Each ... Next loop is finding names in Word doc, then input the names into Excel cells but without THE first name

$
0
0

Hello Stackoverflow community.

The code I need your help with, finds and extracts the counterparts names/surnames from the beginning of the word document, then it puts these names into a consecutive cells in Excel, for example "A12", "A13" and "A14". The word document looks like this:

enter image description here

The target Workbook that macro will write into looks like this:

enter image description here

The majority of the code works just fine but there is one thing I don't know how to achieve:

  1. The full name of the first counterparty found, in the example below it's "Jan STANEK" is not supposed to be written into the worksheet. Macro needs to start entering names from the full name of the second counterparty that's found in a way that: 2nd counterparty's name is written into cell "A12", 3rd counterparty's name is written into cell "A13" and 4th counterparty's name is written into cell "A14" and so on.

The end effect of the macro should be:

  1. "Jan STANEK" is not written anywhere in the worksheet, It's simply extracted while searching through the document but skipped during input to the worksheet phase,
  2. "Michal Lukasz ROESLER" is written into cell "A12",
  3. "Katarzyna Paula STANISZKIS-KRAWCZYK" is written into cell "A13",
  4. "Tomasz Leon Bogdan WISNIAK-STRYCZEWSKI"is written into cell "A14" and so on.
Sub FindNamesByRonRosenfeldWithInput()
    Dim WordApp As Word.Application
    Dim WordDoc As Word.Document
    Dim ExcelApp As Excel.Application
    Dim MySheet As Excel.Worksheet
    Dim Para As Word.Paragraph
    Dim Rng As Word.Range
    Dim pStart As Long
    Dim pEnd As Long
    Dim Length As Long
    Dim TextToFind1 As String
    Dim TextToFind2 As String
    Dim firstName As String
    Dim fullName As Word.Range
    Dim startPos As Long
    Dim endPos As Long
    Dim x As Long

    Application.ScreenUpdating = False

    'Assigning object variables
    Set WordApp = GetObject(, "Word.Application")
    Set ExcelApp = GetObject(, "Excel.Application")
    Set WordDoc = WordApp.ActiveDocument
    Set MySheet = Application.ActiveWorkbook.ActiveSheet
    'Set MySheet = ExcelApp.ActiveWorkbook.ActiveSheet
    Set Rng = WordApp.ActiveDocument.Content
    TextToFind1 = "REGON 364061169, NIP 951-24-09-783,"
    TextToFind2 = "- ad."
    x = 11

    'InStr function returns a Variant (Long) specifying the position of the first occurrence of one string within another.
    startPos = InStr(1, Rng, TextToFind1) - 1    'here we get 1421, we're looking 4 "TextToFind1"
    endPos = InStr(1, Rng, TextToFind2) - 1      'here we get 2497, we're looking 4 "- ad."
    If startPos = 0 Or endPos = 0 Then Exit Sub
    Rng.SetRange Start:=startPos, End:=endPos
    Debug.Print Rng.Paragraphs.Count

    If startPos = 0 Or endPos = 0 Then
        MsgBox ("Client's names were not found!")
    Else
        'The full name of the first counterparty found, is not supposed to be written into the worksheet.
        'It's not important and I just want to skip it.
        'Macro needs to start entering names from the full name of the second counterparty that's found,
        'in a way that: 2nd counterparty's full name is written into cell "A12", 3rd counterparty's full name is written into cell "A13",
        'and 4th counterparty's full name is written into cell "A14" and so on.
        For Each Para In Rng.Paragraphs
            firstName = Trim$(Para.Range.Words(3))
            'Debug.Print firstName
            pStart = InStr(Para, ".") + 1       'here we get 3
            Length = InStr(Para, ",") - pStart  'here we get 14/25/39 - 3
            Debug.Print Trim(Mid(Para, pStart, Length))
            x = x + 1
            Cells(x, 1).Value = Trim(Mid(Para, pStart, Length))
        Next Para
    End If
End Sub

Viewing all articles
Browse latest Browse all 88029

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>