Finding Combinations in a Row Using Macros

[madhuchelliah]

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:

G	H	I
		DDDDDDD
		WWWWW*****
		Today Completed Task
		XXXXXXX
		YYYYYYY
		ZZZZ
		XXXXXX *****
		VVVVVV
		BBBBB*****
		Yesterday Completed Task
		RRRRRRRR
		WWWWW
		VVVVVV*****

<tbody>
</tbody>

Requirement:

G	H	I
		DDDDDDD
		WWWWW*****
Start		Today Completed Task
		XXXXXXX
		YYYYYYY
		ZZZZ
End		XXXXXX *****
		VVVVVV
		BBBBB*****
Start		Yesterday Completed Task
		RRRRRRRR
		WWWWW
End		VVVVVV*****

<tbody>
</tbody>

 

[offthelip]

try this:

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

 

[MickG]

Try this:-

[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

 

[madhuchelliah]

try this:

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!!!!!!

 

[madhuchelliah]

Try this:-

[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

 

[MickG]

You're welcome

 

[madhuchelliah]

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

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

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

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

 

[MickG]

If you can show an example of your data and expected results I'll have another look.!!!