VBA: Find the position of occurrence of text in sentence

[ucan]

VBA: Find the position of occurrence of 2nd sheet keys in Sheet1 sentences and get the results as given in the "Output" sheet.

[georgiboy]

Hi Ucan,

Welcome to the forum.

There will be other ways of doing this so will give you what I created as a start as I have run out of time, i am sure there will be shorter solutions provided but the below may give you something to think about:


Sub test()
Dim rCell As Range, rng As Range, a As Long
Dim mKey As Variant, ID As String
Dim First As Long, Last As Long, Position As String

Set rng = Sheet1.Range("A2:A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row)
mKey = Sheet2.Range("A2:C13").Value
a = 1

For Each rCell In rng.Cells
For x = 1 To UBound(mKey)
First = 0
If mKey(x, 1) = "" Then mKey(x, 1) = " "
If mKey(x, 3) = "" Then mKey(x, 3) = " "
If InStr(rCell.Offset(, 1), (mKey(x, 1) & mKey(x, 2) & mKey(x, 3))) Then
ID = rCell
Do While InStr(1 + First, rCell.Offset(, 1), (mKey(x, 1) & mKey(x, 2) & mKey(x, 3)), vbTextCompare) <> 0
First = InStr(1 + First, rCell.Offset(, 1), (mKey(x, 1) & mKey(x, 2) & mKey(x, 3)), vbTextCompare) + Len(mKey(x, 1))
Last = First + Len(mKey(x, 2)) - 1
Position = "(" & First & " - " & Last & ")"
result = mKey(x, 2) & " " & mKey(x, 1) & Position & mKey(x, 3)
a = a + 1
Sheet3.Range("A" & a & ":E" & a) = Array(ID, result, mKey(x, 2), mKey(x, 1) & mKey(x, 3), Position)
Loop
End If
Next x
Next rCell
End Sub

Hope this helps

[snb]

I put ID@2 in row 3 in sheet1.


Sub M_snb()
sn = Sheet1.Cells(1).CurrentRegion
sp = Array("apple", "who")

With CreateObject("scripting.dictionary")
For j = 2 To UBound(sn)
For jj = 0 To UBound(sp)
st = Split(sn(j, 2), sp(jj))
y = 0
For jjj = 1 To UBound(st)
y = y + Len(st(jjj - 1)) + Len(sp(jj))
.Item(.Count) = Array(sn(j, 1), sp(jj), Right(st(jjj - 1), 1) & Left(st(jjj), 1), "(" & y - Len(sp(jj)) + 1 & "-" & y & ")")
Next
Next
Next

Sheet3.Cells(20, 1).Resize(.Count, 4) = Application.Index(.items, 0)
End With
End Sub

[Paul_Hossler]

VBA: Find the position of occurrence of 2nd sheet keys in Sheet1 sentences and get the results as given in the "Output" sheet.

Welcome to the forum - please take a minute to read the FAQ in my signature

Since this is your first post, as an FYI (since we're all volunteers here) a question usually gets more responses if it starts with

"Please help me to ...."

or

"I'm trying to ... and need some help ..."


and ends with a

"Thanks"

[snb]

@PH

I second that.:thumb

[ucan]

Thank you. worked perfectly but if the "given key" found and starts at number 1 position or ends in the last position of the sentences then I do not get an output for that. Their output as a "-" will be fine for the start and end.
I have to add three more columns data in "match Key" and need to get that also in "Result" column of "Output" sheet separated by pipe symbol (|).
Please help.



Hi Ucan,

Welcome to the forum.

There will be other ways of doing this so will give you what I created as a start as I have run out of time, i am sure there will be shorter solutions provided but the below may give you something to think about:


Sub test()
Dim rCell As Range, rng As Range, a As Long
Dim mKey As Variant, ID As String
Dim First As Long, Last As Long, Position As String

Set rng = Sheet1.Range("A2:A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row)
mKey = Sheet2.Range("A2:C13").Value
a = 1

For Each rCell In rng.Cells
For x = 1 To UBound(mKey)
First = 0
If mKey(x, 1) = "" Then mKey(x, 1) = " "
If mKey(x, 3) = "" Then mKey(x, 3) = " "
If InStr(rCell.Offset(, 1), (mKey(x, 1) & mKey(x, 2) & mKey(x, 3))) Then
ID = rCell
Do While InStr(1 + First, rCell.Offset(, 1), (mKey(x, 1) & mKey(x, 2) & mKey(x, 3)), vbTextCompare) <> 0
First = InStr(1 + First, rCell.Offset(, 1), (mKey(x, 1) & mKey(x, 2) & mKey(x, 3)), vbTextCompare) + Len(mKey(x, 1))
Last = First + Len(mKey(x, 2)) - 1
Position = "(" & First & " - " & Last & ")"
result = mKey(x, 2) & " " & mKey(x, 1) & Position & mKey(x, 3)
a = a + 1
Sheet3.Range("A" & a & ":E" & a) = Array(ID, result, mKey(x, 2), mKey(x, 1) & mKey(x, 3), Position)
Loop
End If
Next x
Next rCell
End Sub

Hope this helps

[snb]

Why did you ignore suggestion #3 ?

[ucan]

By mistake I missed few columns.
I have updated my final example sheet attached. Forgive as my first mistake and please help me.

[ucan]

Help me out

[georgiboy]

Hi ucan,

I come here to help people learn to code - I do it for free, as do others on the forum. There is no need to PM me or others to ask to come help.

The reason I have not replied is this is beginning to look like you need a full on solution and not just help - there are paid options for this in the way of freelance websites etc...