blank row

[Drakestar]

Hi,

I am trying to figure out a way to put the below values


A A1
B B1
C D1
D E1
E E2
F E3
F1



In this order


A A1

B B1

C

D D1

E E1
E2
E3

F F1



Where A is a word that appears the text of cell A1, etc. In the case of C the value doesn't appear
E1, E2 and E3 should be below each other.

[ashleyuk1984]

Do you have a list of values that are currently on the spreadsheet that needs to be sorted? If so where?
And how do you want to proceed going forward... Adding more in the future I mean.

[Drakestar]

Yes the values are currently on the spreadsheet, I have attached the macro. The values don't really need to be sorted if you run it, it will return the values, it's just when a value is not in the word document it just adds the result under the last value found.

Yes I would like to add more values that can be found in the future.

For exampled if the test words are
dog
house
street

And this is in the word document, you'll see what I mean.

That is a nice dog.
The dog is in the garden
He lives in a nice street.
In the street there is a car.





Sub Wordsearch()
Dim Wapp As Object, STRtoFind As String, Sourcefile As String
Dim Cnt2 As Integer, Cnt As Integer, Opara As Object
Dim Lastrow As Integer
Sourcefile = "C:\testfile.docx"
On Error GoTo Erfix
Set Wapp = CreateObject("Word.Application")
Wapp.Documents.Open Filename:=Sourcefile, ReadOnly:=True
With Sheets("Sheet1")
Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
For Cnt = 1 To Lastrow
STRtoFind = CStr(Sheets("Sheet1").Range("A" & Cnt).Value)

For Each Opara In Wapp.ActiveDocument.Paragraphs
With Opara.Range.Find
.Text = STRtoFind
.Forward = True
.MatchWholeWord = True
.Execute
If .found = True Then
Cnt2 = Cnt2 + 1
Sheets("Sheet1").Range("B" & Cnt2).Value = Opara.Range
End If
End With
Next Opara

Next Cnt
Wapp.ActiveDocument.Close savechanges:=False
Wapp.Quit
Set Wapp = Nothing
Exit Sub

Erfix:
On Error GoTo 0
MsgBox "Error"
Wapp.Quit
Set Wapp = Nothing
End Sub