Nested For Each Statement: Identifying Key words from Range within a Range

[Infoconstructionrecruit]

Dear Mr Excel
I would be so grateful for some help with this.

I have 4 Sheets that contain data that i am trying to write a code for.
MessagesSheet (Which is named "replies" followed by "date" and "time"): This contains text messages received. The data is organised as follows: Each row contains the Contact number and the messages for that number are displayed on the same row in each column for the number of messages received.

I then have three separate sheets which contain key words I would like to identify within the MessagesSheet. Some of the key words are part of a sentence, therefore forming 3 or 4 words together.:
PositiveResponsesSheet
NegativeResponsesSheet
MaybeResponsesSheet.

I need the code to systematically use a For Each Statement to perform the following task:
Look at each cell within the MessagesSheet and check each of the cells within the Key Words Sheets if they keys words appear in the MessagesSheet. If the result is positive, populate a cell in column 3 with text indicating one of the following Strings:
P (Positive)
N (Negative)
M Maybe)

Some of the Key words in the above sheets have key words in separate columns, i am looking for these key words to be searched with a wild card in between the two key words.

Then if a key word has been identified for more than one of the key word sheets, then return to column 3 a M.

Then the rest i should be ok with, however i would be open to suggestions for how i add a few other conditionals within those loops, such as:
If the message is a message i have sent, skip (Messages i sent would be in another sheet within the same workbook)
If the messages received have been messages received already (Each time messages are received another sheet is added, showing the new messages, but it includes all the old messages.

Sample of sheet is available on this link. https://wetransfer.com/downloads/0ac64cdccd316eb0395d7da2f0a66eb920220621204813/04997f1bb42369ed9da916b28f01b66520220621204836/a61330

 

[shknbk2]

Then if a key word has been identified for more than one of the key word sheets, then return to column 3 a M.

Looking at row 3, Returned3 would be a Maybe since it has "chat Monday", but Returned4 would be a Positive since it has "would be interested". So in this case, would column 3 be an M or a P? Do you want col 3 to be defined by the last response? (In this case, row 3 would be a P since the positive message trumps the maybe message sent earlier)

 

[Infoconstructionrecruit]

Hi thanks for your response.
If any of the messages from a contact have a mix of P, N or M responses within the messages received. Then the response should be returned as M.

That's why I need the final part of the code to read across previously received messages in the other sheets to exclude those from the code, so it isn't reading previously read and received messages.

Everytime messages are downloaded onto the new sheet, they include the whole history. So the code should exclude the previous sheets, as they would have already been processed.

 

[shknbk2]

This is what I have come up with for looking only at each Replies worksheet individually without considering any other information like whether to exclude the information or not based on previous processing. That might come later. Let's just see if it works like you want it in a basic form.

Option Explicit

Sub DetermineResponseTypes()
    Dim shP As Worksheet
    Dim shN As Worksheet
    Dim shM As Worksheet
    Dim aSh As Worksheet
    Dim lastRow As Long
    Dim cReply As Range
    Dim Result As Integer
    Dim sFind As String

    Set shP = Worksheets("Positive Responses")
    Set shN = Worksheets("Negative Responses")
    Set shM = Worksheets("Maybe")
    
    For Each aSh In Worksheets
        If InStr(1, aSh.Name, "Replies") > 0 Then
            Result = 0
            lastRow = aSh.Cells(aSh.Rows.Count, 1).End(xlUp).Row
            For Each cReply In aSh.Range(aSh.Cells(2, 1), aSh.Cells(lastRow, 1))
                'Find positive responses
                Result = FindResponse(cReply, shP, 4)
                'Find negative responses
                Result = Result + FindResponse(cReply, shN, 2)
                'Find maybe responses
                Result = Result + FindResponse(cReply, shM, 1)

                aSh.Cells(cReply.Row, 3) = ""
                Select Case Result
                    Case 1 'Maybe only
                        aSh.Cells(cReply.Row, 3) = "M"
                    Case 2 'Negative only
                        aSh.Cells(cReply.Row, 3) = "N"
                    Case 4 'Positive only
                        aSh.Cells(cReply.Row, 3) = "P"
                    Case 5 'Pos & maybe
                        aSh.Cells(cReply.Row, 3) = "M (P & M)"
                    Case 6 'Neg & maybe
                        aSh.Cells(cReply.Row, 3) = "M (N & M)"
                    Case 7 'All 3
                        aSh.Cells(cReply.Row, 3) = "M (P & N & M)"
                End Select
            Next
        End If
    Next
End Sub

Function FindResponse(SearchTarget As Range, ResponseSheet As Worksheet, flag As Integer) As Integer
    Dim cResponse As Range
    Dim c As Range
    Dim cFind As Range
    Dim sFind As String
    
    FindResponse = 0
    Set cResponse = ResponseSheet.Range("A1", ResponseSheet.Cells(ResponseSheet.Rows.Count, 1).End(xlUp))
    For Each c In cResponse
        If c.Value <> "" Then
            If c.Offset(0, 1).Value <> "" Then
                sFind = c.Value & "*" & c.Offset(0, 1).Value
            Else
                sFind = c.Value
            End If
            
            sFind = Replace(sFind, "?", "~?")
            Set cFind = SearchTarget.EntireRow.Find(What:=sFind, LookAt:=xlPart, MatchCase:=False)

            If Not cFind Is Nothing Then
                FindResponse = flag
                Exit For
            End If
        End If
    Next
End Function

 

[Infoconstructionrecruit]

Dear shknbk2

That's great. I have had a few test runs and this is what I need it to run like.
From the test runs I completed I can see each Key Response sheet (P, M & N) are dynamic, with regards to number of rows I can add and number of columns I can add (with wild cards to separate each string), so I can add as many key responses as required to refine the responses.

With regards to developing and refining this code:
I have added the Workbook again (see link below)

I have added a Sheet called "Exclude Messages", these messages are a collection of messages which I have sent, there I would like to exclude them when running the code, as these messages are responsible for some of the P, N and M responses.

I tried to alter the code you wrote, so that it only loops through the replies on the active replies sheet, as I only need it to run the code on the most up to date replies.
However as mentioned previously all other replies should be excluded on the most up to date replies sheet, as I am only interested in new messages that have not been received.
SampleSheetForMrExcel 24.06.xlsx.xlsm

I do have one other task that is beyond me, with regards to tidying up a code.
I have a code using SeleniumBasic that I run (and i wrote! over a period of weeks of learning) to obtain the messages from the messaging site (whatsapp webb), however I can only obtain the messages. I cannot obtain the specifics of the messages, such as date and time, and who sent the message. If I could obtain that extra data, that would make my job a lot easier when reading the messages, but also I would not have to have a separate sheet for excluded messages. The specific information about the messages is only contained within the names of the tags themselves. The data is dynamic though, so it is not like I can incorporate that into my code.

With regards to the Selenium Basic, I just wondered what knowledge you had of this? One problem at a time though!

Again I really appreciate the help and guidance with this project.
Thank you.

 

[shknbk2]

How does this work for the replies workbook?

Option Explicit

Sub DetermineResponseTypes()
    Dim shP As Worksheet
    Dim shN As Worksheet
    Dim shM As Worksheet
    Dim shE As Worksheet
    Dim excludes() As String
    Dim eCnt As Integer
    Dim aSh As Worksheet
    Dim lastRow As Long
    Dim cReply As Range
    Dim c As Range
    Dim Result As Integer
    Dim sFind As String
    Dim rowResponses() As String
    Dim rCnt As Integer
    Dim endCol As Integer
    Dim excluded As Boolean
    Dim i As Integer
    
    Set shP = Worksheets("Positive Responses")
    Set shN = Worksheets("Negative Responses")
    Set shM = Worksheets("Maybe")
    Set shE = Worksheets("Messages to Exclude")
    eCnt = -1
    With shE
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For Each cReply In .Range(.Cells(1, 1), .Cells(lastRow, 1))
            If cReply.Value <> "" Then
                eCnt = eCnt + 1
                ReDim Preserve excludes(eCnt)
                excludes(eCnt) = cReply.Value
            End If
        Next
    End With
    
    Set aSh = ActiveSheet
    If InStr(1, aSh.Name, "Replies") > 0 Then
        Result = 0
        lastRow = aSh.Cells(aSh.Rows.Count, 1).End(xlUp).Row
        For Each cReply In aSh.Range(aSh.Cells(2, 1), aSh.Cells(lastRow, 1))
            
            rCnt = -1
            ReDim rowResponses(0)
            rowResponses(0) = ""
            endCol = Cells(cReply.Row, Columns.Count).End(xlToLeft).Column
            For Each c In Range(Cells(cReply.Row, 6), Cells(cReply.Row, endCol))
                If c.Value <> "" Then
                    excluded = False
                    For i = 0 To UBound(excludes)
                        If c.Value = excludes(i) Then
                            excluded = True
                            Exit For
                        End If
                    Next
                    If Not excluded Then
                        rCnt = rCnt + 1
                        ReDim Preserve rowResponses(rCnt)
                        rowResponses(rCnt) = c.Value
                    End If
                End If
            Next
            
            If rCnt > -1 Then
                'Find positive responses
                Result = FindResponse(rowResponses, shP, 4)
                'Find negative responses
                Result = Result + FindResponse(rowResponses, shN, 2)
                'Find maybe responses
                Result = Result + FindResponse(rowResponses, shM, 1)
            End If
            
            aSh.Cells(cReply.Row, 3) = ""
            Select Case Result
                Case 1 'Maybe only
                    aSh.Cells(cReply.Row, 3) = "M"
                Case 2 'Negative only
                    aSh.Cells(cReply.Row, 3) = "N"
                Case 4 'Positive only
                    aSh.Cells(cReply.Row, 3) = "P"
                Case 5 'Pos & maybe
                    aSh.Cells(cReply.Row, 3) = "M (P & M)"
                Case 6 'Neg & maybe
                    aSh.Cells(cReply.Row, 3) = "M (N & M)"
                Case 7 'All 3
                    aSh.Cells(cReply.Row, 3) = "M (P & N & M)"
            End Select
        Next
    End If
End Sub

Function FindResponse(rowResponses() As String, ResponseSheet As Worksheet, flag As Integer) As Integer
    Dim cResponse As Range
    Dim c As Range
    Dim sFind As String
    Dim i As Integer
        
    FindResponse = 0
    Set cResponse = ResponseSheet.Range("A1", ResponseSheet.Cells(ResponseSheet.Rows.Count, 1).End(xlUp))
    For Each c In cResponse
        If c.Value <> "" Then
            If c.Offset(0, 1).Value <> "" Then
                sFind = "*" & c.Value & "*" & c.Offset(0, 1).Value & "*"
            Else
                sFind = "*" & c.Value & "*"
            End If
            sFind = Replace(sFind, "?", "[?]")
            
            For i = 0 To UBound(rowResponses)
                If rowResponses(i) Like sFind Then
                    FindResponse = flag
                    Exit For
                End If
            Next
        End If
    Next
End Function

 

[Infoconstructionrecruit]

Dear Shknkp2

Thanks for the update code.
It is so nearly there.
I just need the code to exclude the messages, with a wild card either side of the message.
For example i may put a phrase within the exclude messages sheet, therefore if that appears within the message, it should completely disregard that message.
It is also not excluding the previously read messages.

So i may have multiple sheets which are reply sheets.
Each time i download messages, i need the code to exclude the previous messages too, if they are the same old messages.

Does that make sense?