Finding Combinations in a Row Using Macros

madhuchelliah

Board Regular
Joined
Nov 22, 2017
Messages
226
Office Version
  1. 2019
Platform
  1. Windows
Hey Guys, I need your help to solve my issue. In my sales report I column i have to find my completed tasks. Typically to identify tasks in I column, it will start with cell contains Completed Task and ends in cells contains *****. Some time some cells contains ***** alone which is incomplete task(See the example below). Now the macros should find the Completed Task and ***** combinations to mark with start and end in G column. Please heads up. Thank you.

Scenario:

[TABLE="class: grid, width: 300, align: left"]
<tbody>[TR]
[TD="align: center"]G
[/TD]
[TD="align: center"]H
[/TD]
[TD="align: center"]I
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]DDDDDDD[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]WWWWW*****[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]Today Completed Task[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]XXXXXXX[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]YYYYYYY[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]ZZZZ[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]XXXXXX *****[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]VVVVVV[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]BBBBB*****[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]Yesterday Completed Task[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]RRRRRRRR[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]WWWWW[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]VVVVVV*****[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
Requirement:

[TABLE="class: grid, width: 300, align: left"]
<tbody>[TR]
[TD="align: center"]G
[/TD]
[TD="align: center"]H
[/TD]
[TD="align: center"]I
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]DDDDDDD[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]WWWWW*****[/TD]
[/TR]
[TR]
[TD]Start[/TD]
[TD][/TD]
[TD]Today Completed Task[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]XXXXXXX[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]YYYYYYY[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]ZZZZ[/TD]
[/TR]
[TR]
[TD]End[/TD]
[TD][/TD]
[TD]XXXXXX *****[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]VVVVVV[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]BBBBB*****[/TD]
[/TR]
[TR]
[TD]Start[/TD]
[TD][/TD]
[TD]Yesterday Completed Task[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]RRRRRRRR[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]WWWWW[/TD]
[/TR]
[TR]
[TD]End[/TD]
[TD][/TD]
[TD]VVVVVV*****[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
try this:

Code:
Sub complete()
Dim txt As String
lastrow = Cells(Rows.Count, "I").End(xlUp).Row
inarr = Range(Cells(1, 9), Cells(lastrow, 9))
 Status = "complete"
 For i = 1 To lastrow
   If Status = "complete" Then
   txt = inarr(i, 1)
   If InStr(txt, "Completed Task") > 0 Then
    Cells(i, 7) = "Start"
    Status = "started"
   End If
   End If
   If Status = "started" Then
   If InStr(inarr(i, 1), "*****") > 0 Then
    Cells(i, 7) = "End"
    Status = "complete"
   End If
   End If
Next i
End Sub
 
Upvote 0
Try this:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG23Jan32
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, fd [COLOR="Navy"]As[/COLOR] Boolean, R [COLOR="Navy"]As[/COLOR] Range, nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(("I2"), Range("I" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Right(Dn.Value, 14) = "Completed Task" [COLOR="Navy"]Then[/COLOR]
        Dn.Offset(, -2) = "Start"
        fd = True
    [COLOR="Navy"]ElseIf[/COLOR] fd [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = Dn Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] nRng.Areas
   [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Dn
        [COLOR="Navy"]If[/COLOR] Len(R.Value) > 5 And Right(R.Value, 5) = "*****" [COLOR="Navy"]Then[/COLOR]
            R.Offset(, -2).Value = "End"
            [COLOR="Navy"]Exit[/COLOR] For
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] R
 [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
try this:

Code:
Sub complete()
Dim txt As String
lastrow = Cells(Rows.Count, "I").End(xlUp).Row
inarr = Range(Cells(1, 9), Cells(lastrow, 9))
 Status = "complete"
 For i = 1 To lastrow
   If Status = "complete" Then
   txt = inarr(i, 1)
   If InStr(txt, "Completed Task") > 0 Then
    Cells(i, 7) = "Start"
    Status = "started"
   End If
   End If
   If Status = "started" Then
   If InStr(inarr(i, 1), "*****") > 0 Then
    Cells(i, 7) = "End"
    Status = "complete"
   End If
   End If
Next i
End Sub

Hello offthelip, Thank you working great!!!!!!
 
Upvote 0
Try this:-
Code:
[COLOR=Navy]Sub[/COLOR] MG23Jan32
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, fd [COLOR=Navy]As[/COLOR] Boolean, R [COLOR=Navy]As[/COLOR] Range, nRng [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Set[/COLOR] Rng = Range(("I2"), Range("I" & Rows.Count).End(xlUp))
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
    [COLOR=Navy]If[/COLOR] Right(Dn.Value, 14) = "Completed Task" [COLOR=Navy]Then[/COLOR]
        Dn.Offset(, -2) = "Start"
        fd = True
    [COLOR=Navy]ElseIf[/COLOR] fd [COLOR=Navy]Then[/COLOR]
            [COLOR=Navy]If[/COLOR] nRng [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR] [COLOR=Navy]Set[/COLOR] nRng = Dn Else [COLOR=Navy]Set[/COLOR] nRng = Union(nRng, Dn)
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] nRng.Areas
   [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] R [COLOR=Navy]In[/COLOR] Dn
        [COLOR=Navy]If[/COLOR] Len(R.Value) > 5 And Right(R.Value, 5) = "*****" [COLOR=Navy]Then[/COLOR]
            R.Offset(, -2).Value = "End"
            [COLOR=Navy]Exit[/COLOR] For
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]Next[/COLOR] R
 [COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick

Hello Mick, code is working great!!!!. Thank you
 
Last edited:
Upvote 0
Hello Mick, I am using some batch of macros in my process along with the above code you provided. Have a look at the 3 codes below You know the 1st code process.2nd code is to fill the word "success" between "Start" and "End.3rd is to fill the word "Pending" in the empty cells in the column. The problem is there is no Start and End word possibilities now coz no task is completed, so the 2nd code no need of filling success. Since all the cells are empty the 3rd code should fill the word Pending but the code is not filling also stopped doing nothing. I cant able to figure out the issue.Could you please help me on this? Thank you.

Code 1

Code:
Sub CompletedTask()
Dim Rng As Range, Dn As Range, fd As Boolean, R As Range, nRng As Range
Set Rng = Range(("I2"), Range("I" & Rows.Count).End(xlUp))
For Each Dn In Rng
    If Right(Dn.Value, 14) = "Completed Task" Then
        Dn.Offset(, -2) = "Start"
        fd = True
    ElseIf fd Then
            If nRng Is Nothing Then Set nRng = Dn Else Set nRng = Union(nRng, Dn)
    End If
Next Dn
For Each Dn In nRng.Areas
   For Each R In Dn
        If Len(R.Value) > 5 And Right(R.Value, 5) = "*****" Then
            R.Offset(, -2).Value = "End"
            Exit For
        End If
    Next R
 Next Dn
Call Success
End Sub


Code 2

Code:
Sub Success()
Dim rng As Range, Dn As Range
Set rng = Range("G:G").SpecialCells(xlCellTypeBlanks)
    If Not rng Is Nothing Then
        For Each Dn In rng.Areas
            If Dn(1).Offset(-1) = "Start" Then Dn.Value = "Success"
        Next Dn
    End If
    Call Pending
End Sub

Code 3

Code:
Sub Pending()
lRow = Range("C" & Rows.Count).End(xlUp).Row
Set MR = Range("G2:G" & lRow)
For Each cell In MR
If cell.Text = "" Then cell.Value = "Pending"

    Next
Call Report
End Sub
 
Last edited:
Upvote 0
If you can show an example of your data and expected results I'll have another look.!!!
 
Upvote 0

Forum statistics

Threads
1,223,953
Messages
6,175,598
Members
452,658
Latest member
GStorm

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top