Finding Address of The 2nd Instance of a value in a range

[Ark68]

I have a range of 32 cells ... BM1:CR1

I am looking for code that will:

a) search from BM to CR looking for the address of the second instance of the word "Church"
b) return the value in the cell two cells left of it

 

[Ark68]

OK ... and I've discovered though that Instance Number has to be a constant (?). The number refers to the instance being sought 1-4.
In my application, depending on the number of possible instances 1-4, this value will change. So, I'm looping this code for each instance. So if there are 3 possible instances, the code will loop 3 times. The 1st loop looks for the 1st occurrence, the 2nd loop the second, and the 3rd the 3rd ... and so to a maximum of four. How would I assign the constant InstanceNumber in this situation?

Sub colorme()

Dim wshrpt As Worksheet
Dim wshcore As Worksheet
Dim iy As Integer 'how many DT's
Dim llastrow As Integer
Dim rdata As Range
Dim fWhat As String
Dim vA As Variant
Dim Ct As Long
Dim r As Range
Const InstanceNumber As Long = 1

Set wshrpt = Worksheets("RPL")
Set wshcore = Worksheets("CONTROL_1")
fWhat = "Kelcey"

llastrow = wshrpt.Range("R" & Rows.Count).End(xlUp).Row
Set rdata = wshrpt.Range("R13:R" & llastrow)

iy = Application.CountIf(rdata, "DT")
'MsgBox iy

For t = 1 To iy
    LastRowOfDT = rdata.Find("DT", searchdirection:=xlPrevious, LookIn:=xlValues, lookat:=xlWhole).Row
    RID = wshrpt.Range("A" & LastRowOfDT)
    RIDrow = wshcore.Range("A:A").Find(RID, searchdirection:=xlPrevious, LookIn:=xlValues, lookat:=xlWhole).Row
    MsgBox "Last DT at ROW: " & LastRowOfDT & Chr(13) & "RID: " & RID & "   " & RIDrow
    'Worksheets("RPL").Rows(LastRowOfD).Insert
    irelines = Application.CountIf(wshrpt.Range("M" & LastRowOfDT & ":P" & LastRowOfDT), fWhat)
    'MsgBox irelines
    LastRowOfD = rdata.Find("D*", searchdirection:=xlPrevious, LookIn:=xlValues, lookat:=xlWhole).Row + 1
    For x = 1 To irelines
        With wshrpt
            .Rows(LastRowOfDT).EntireRow.Copy
            .Rows(LastRowOfD).Insert
            With .Range("H" & LastRowOfD & ":L" & LastRowOfD)
                .Value = ""
                .Interior.ColorIndex = 15
            End With
            If x = 1 Then
                With .Range("N" & LastRowOfD & ":P" & LastRowOfD)
                    .Value = ""
                    .Interior.ColorIndex = 15
                End With
                With wshcore.Range("BM" & RIDrow & ":CR" & RIDrow)
                    vA = .Value
                    For i = LBound(vA, 2) To UBound(vA, 2)
                        If InStr(vA(1, i), fWhat) > 0 Then
                            Ct = Ct + 1
                            If Ct = InstanceNumber Then
                                MsgBox "Instance number " & InstanceNumber & "found in cell " & .Cells(1, i).Address
                                MsgBox .Cells(1, i).Offset(0, -2).Value
                                With wshrpt
                                    .Range("B" & LastRowOfD) = .Cells(1, i).Offset(0, -2).Value
                                End With
                                Exit Sub
                            End If
                        End If
                    Next i
                    MsgBox "Only " & Ct & " instances of " & fWhat & " were found."
                End With

                          
            ElseIf x = 2 Then
                With .Range("M" & LastRowOfD, "O" & LastRowOfD & ":P" & LastRowOfD)
                    .Value = ""
                    .Interior.ColorIndex = 15
                End With

                ' Repeat blue code: Instance Number 2



            ElseIf x = 3 Then
                With .Range("M" & LastRowOfD & ":N" & LastRowOfD, "P" & LastRowOfD)
                    .Value = ""
                    .Interior.ColorIndex = 15
                End With

                ' Repeat blue code: Instance Number 3
                
            Else 'x = 4 Then
                With .Range("M" & LastRowOfD & ":O" & LastRowOfD)
                    .Value = ""
                    .Interior.ColorIndex = 15
                End With
          
           ' Repeat blue code: Instance Number 4
           
 
            End If
            '.Rows(LastRowOfD).PasteSpecial
            
        End With
    Next x
Next t

End Sub

Oh ... the code in red doesn't do what I was hoping ... putting the value in that cell.

 

[Rick Rothstein]

Here is a function that should do what you want. It can be called from other VB code or directly within a worksheet formula as a UDF (user defined function). The function assumes the range BM1:CR1 is fixed (that can be changed if need be) so the function only has one argument... the instance number of the occurrence of the word "Church" for which you want the value in the cell two columns to the left of.

Function TwoBeforeChurch(Instance As Long) As Variant
  Dim Combined As String, Churches() As String
  Combined = Application.Trim(Join(Application.Index(Range("BM1:CR1").Value, 1, 0), Chr(1)))
  Churches = Split(Combined, "Church", , vbTextCompare)
  Churches = Split(Churches(Instance - 1), Chr(1))
  TwoBeforeChurch = Churches(UBound(Churches) - 2)
End Function

 

[Rick Rothstein]

Here is a function that should do what you want. It can be called from other VB code or directly within a worksheet formula as a UDF (user defined function). The function assumes the range BM1:CR1 is fixed (that can be changed if need be) so the function only has one argument... the instance number of the occurrence of the word "Church" for which you want the value in the cell two columns to the left of.

Function TwoBeforeChurch(Instance As Long) As Variant
  Dim Combined As String, Churches() As String
  Combined = Application.Trim(Join(Application.Index(Range("BM1:CR1").Value, 1, 0), Chr(1)))
  Churches = Split(Combined, "Church", , vbTextCompare)
  Churches = Split(Churches(Instance - 1), Chr(1))
  TwoBeforeChurch = Churches(UBound(Churches) - 2)
End Function

I just noticed your code varies the row number which you are searching on. Also, that you might want to search for some words other than "Church". Here is the above code modified to allow you to do that. To that end, I changed the argument list so that the first argument is the word you want to search for, the second argument is the row number to perform the search on (with the column range still being BM to CR) and the third argument is the instance number of that word...

Function TwoBefore(WhatWord As String, RowNumber As Long, Instance As Long) As Variant
  Dim Combined As String, What() As String
  Combined = Application.Trim(Join(Application.Index(Range("BM" & RowNumber & ":CR" & RowNumber).Value, 1, 0), Chr(1)))
  What = Split(Combined, WhatWord, , vbTextCompare)
  What = Split(What(Instance - 1), Chr(1))
  TwoBefore = What(UBound(What) - 2)
End Function

 

[Ark68]

Always appreciated Rick, thank you. This will take a bit of digesting ... I've never worked with functions in this manner before.
Silly question ... this entire function is the "result" I want to put into the final destination cell? ie. B4 = Function TwoBeforeChurch?
I'm not sure what this is going to return ...

 

[Rick Rothstein]

Always appreciated Rick, thank you. This will take a bit of digesting ... I've never worked with functions in this manner before.
Silly question ... this entire function is the "result" I want to put into the final destination cell? ie. B4 = Function TwoBeforeChurch?

First off, make sure you see my revised code in Message #13....

Yes, the function returns the contents in the cell that is two columns to the left of the cell containing the word you searched for on the row you specified for the instance of the word you specified... just pass in the arguments and the function will do its work automatically (like any other function you have ever used... nothing magical about it except that the workings of the function are programmed for a specific designated purpose rather than being generic in nature).

 

[Ark68]

Hi Rick ... been doing some reading on custom functions, and trying to relate what you're presented with what I'm reading. Didn't amount to much LOL. I did learn the function goes into a separate module, and is called from the VBA. That is where I lose it.

I can assign your function to a variable?

variable = application.TwoBefore ....

But from this point (if this is a starting point at all), I'm uncertian. Somewhere I have to pass some arguments ... which ones, how, and where are head scratchers.

Jenn

 

[Ark68]

I've been experimenting to try to work through my question ...

I've added this to my main code ....

wsty = Application.TwoBefore("Kelcey", RIDrow, 1)
MsgBox wsty

Where:
"WhatWord" = "Kelcey"
"RowNumber" = RIDrow = wshcore.Range("A:A").Find(RID, searchdirection:=xlPrevious, LookIn:=xlValues, lookat:=xlWhole).Row = 23
"Instance" = 1

Executing this results in an "Object doesn't support this property or method" error in the function line.

 

[Rick Rothstein]

I've been experimenting to try to work through my question ...

I've added this to my main code ....

wsty = Application.TwoBefore("Kelcey", RIDrow, 1)
MsgBox wsty

Where:
"WhatWord" = "Kelcey"
"RowNumber" = RIDrow = wshcore.Range("A:A").Find(RID, searchdirection:=xlPrevious, LookIn:=xlValues, lookat:=xlWhole).Row = 23
"Instance" = 1

Executing this results in an "Object doesn't support this property or method" error in the function line.

The TwoBefore is not a function belonging to the Application object... it is just a function, so call it like you would call any other normal VB function... by itself. Try it like this instead...

wsty = TwoBefore("Kelcey", RIDrow, 1)

 

[Ark68]

OK ... made the change, ran through the code and no errors. But the value for TwoBefore is coming out as "".
I double checked the source database, and the required row is indeed 23, data ... including the name "Kelcey", is found in the range BM23:CR23, the first instance being cell BS23.

 

[Ark68]

I found the problem ...

Combined = Application.Trim(Join(Application.Index(dataworksheet.Range("BM" & RowNumber & ":CR" & RowNumber).Value, 1, 0), Chr(1)))

The function was looking for data in the wrong worksheet.