Do Until loop not working..

[VBABEGINER]

Can any one please help me to correct the do until loop...it is not working...

Please..

Do Until j = Range("Z" & Rows.Count).End(xlUp).Row

str = Range("Z" & j).Value

Set Fndtx = Range("AA2", Cells(LastRow, lastColumn)).Find(What:=str, After:=Range("AA2"), _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If Not Fndtx Is Nothing Then
p = Right(Fndtx.Address, 2)
Range("A" & p).Interior.Color = vbGreen
End If


j = j + 1
Loop

 

[DushiPunda]

1. Can you provide your entire macro?
2. Any reason you're using Do/Until instead of For/Next?
3. What exactly isn't working? Are you getting undesired results? Are you getting any errors?

 

[Fluff]

Try

If Not Fndtx Is Nothing Then
Range("A" & Fndtx.Row).Interior.Color = vbGreen
End If

 

[VBABEGINER]

Hey Thank You so much Fluff, to understand me correct.

Aside, Hello Dushi, Thank You for your reply and understanding my query.

Yes, previous I was using For Next loop. But Now I wanted to use, Do Loop...The reason b'coz....

My entire code was perfectly working. Scenario is, value pick up from col Z one by one and it finds in range after Col AA. If it finds (in AA after area) then Green Color should mark to Col A.

But now I found that, some text which user put in Col A, are repeat twice or thrice time. I will give u example...

Col Z (some unique values..)
ABC
PQR
XYZ

Col A (are having statements..)
My mango abc here.
paris is nice and pqr.
paris is cool
paris xyz having more than mangos
abc here alone staying

Look at the above example...in Col A
"abc" is already in AC2 cell. It finds one time only in For Next loop.

I want to find "abc" whatever be the number that all should get highlighted in Col A.


I will post my code entire...

Sub test()
Dim i As Integer
Dim j As Integer
Dim str As String
Dim Fndtx As Range
Dim lastColumn As Long
Dim LastRow As Long
Dim p


Application.ScreenUpdating = False
Application.DisplayAlerts = False


Range("A2", Range("A2").End(xlDown)).Copy Range("AA2")


Range("AA2", Range("AA2").End(xlDown)).TextToColumns Destination:=Range("AA2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
TrailingMinusNumbers:=True

lastColumn = ActiveSheet.Cells.SpecialCells(xlLastCell).Column
LastRow = Cells(Rows.Count, "AA").End(xlUp).Row
'LastRow = Cells(Rows.Count, lastColumn).End(xlUp).Row


For j = 2 To Range("Z" & Rows.Count).End(xlUp).Row
str = Range("Z" & j).Value
Set Fndtx = Range("AA2", Cells(LastRow, lastColumn)).Find(What:=str, After:=Range("AA2"), _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)


If Not Fndtx Is Nothing Then
Range("A" & Fndtx.Row).Interior.Color = vbGreen
End If


' If Not Fndtx Is Nothing Then
' p = Right(Fndtx.Address, 2)
' Range("A" & p).Interior.Color = vbGreen
' End If
Next j


'//*****************************************************************


Do Until j = Range("Z" & Rows.Count).End(xlUp).Row
str = Range("Z" & j).Value
Set Fndtx = Range("AA2", Cells(LastRow, lastColumn)).Find(What:=str, After:=Range("AA2"), _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If Not Fndtx Is Nothing Then
Range("A" & Fndtx.Row).Interior.Color = vbGreen
End If

' If Not Fndtx Is Nothing Then
' p = Right(Fndtx.Address, 2)
' Range("A" & p).Interior.Color = vbGreen
' End If

j = j + 1
Loop


Range(Cells(1, 27), Cells(1, lastColumn)).EntireColumn.Select
Selection.Delete Shift:=xlToLeft

Range("A1").Select

Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub

Try

If Not Fndtx Is Nothing Then
Range("A" & Fndtx.Row).Interior.Color = vbGreen
End If

 

[VBABEGINER]

This is my workbook.

Col A2 onward, user can paste the data .i.e. Statements..

BENEFITS DET

ABC EMP Mango

Nature is Great

Mango PQR here

Lemmon here XYZ

where LEO AND

PQR CAN

So much traffic MO

ABC ends nothing

Canteen XYZ always

<colgroup><col></colgroup><tbody>
</tbody>

 

[VBABEGINER]

In Col AA onwards data spilt like this...

BENEFITS	DET
ABC	EMP	Mango
Nature	is	Great
Mango	PQR	here
Lemmon	here	XYZ
where	LEO	AND
PQR	CAN
So	much	traffic	MO
ABC	ends	nothing
Canteen	XYZ	always

<colgroup><col><col span="3"></colgroup><tbody>
</tbody>

 

[VBABEGINER]

In Col Z, I have Unique values...

ABC

MO

XYZ

PQR

LEO

<colgroup><col width="64" style="width:48pt"> </colgroup><tbody>
</tbody>

 

[VBABEGINER]

In For..Next loop it finds correctly ABC 1st time and mark Green color to the respective Col A cell whichever is come 1st. But ABC value comes again that time it is not highlighting...

That is the reason I want to use Do Until loop...

Hope this explains now...

 

[Fluff]

Wrong

 

[Fluff]

Try

Sub test()

    Dim Fnd As Long
    Dim Cl As Range
    Dim Cnt As Long
    Dim Fndtx As Range
    Dim LastRow As Long
    Dim LastCol As Long
    Dim NxtFnd As Range


Application.ScreenUpdating = False
Application.DisplayAlerts = False


    Range("A2", Range("A2").End(xlDown)).Copy Range("AA2")
    
    Range("AA2", Range("AA2").End(xlDown)).TextToColumns Destination:=Range("AA2"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
    TrailingMinusNumbers:=True
    
    LastCol = ActiveSheet.Cells.SpecialCells(xlLastCell).Column
    LastRow = Cells(Rows.Count, "AA").End(xlUp).Row
    
    Set Fndtx = Range("AA2")
    For Each Cl In Range("Z2", Range("Z" & Rows.Count).End(xlUp))
        Cnt = WorksheetFunction.Countif(Range("AA2", Cells(LastRow, LastCol)), Cl.Value)
        If Cnt > 0 Then
            For Fnd = 1 To Cnt
                Set Fndtx = Range("AA2", Cells(LastRow, LastCol)).Find(What:=Cl.Value, After:=Fndtx, _
                LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
                Range("A" & Fndtx.Row).Interior.Color = vbGreen
            Next Fnd
        End If
    Next Cl
    
    Range(Cells(1, 27), Cells(1, LastCol)).EntireColumn.Delete Shift:=xlToLeft
    Range("A1").Select

Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub