Do Until loop not working..

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,284
Office Version
  1. 365
Platform
  1. Windows
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
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
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?
 
Upvote 0
Try
Code:
If Not Fndtx Is Nothing Then
Range("A" & Fndtx.Row).Interior.Color = vbGreen
End If
 
Upvote 0
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
Code:
If Not Fndtx Is Nothing Then
Range("A" & Fndtx.Row).Interior.Color = vbGreen
End If
 
Upvote 0
This is my workbook.

Col A2 onward, user can paste the data .i.e. Statements..
[TABLE="width: 320"]
<colgroup><col></colgroup><tbody>[TR]
[TD]BENEFITS DET[/TD]
[/TR]
[TR]
[TD]ABC EMP Mango[/TD]
[/TR]
[TR]
[TD]Nature is Great[/TD]
[/TR]
[TR]
[TD]Mango PQR here[/TD]
[/TR]
[TR]
[TD]Lemmon here XYZ[/TD]
[/TR]
[TR]
[TD]where LEO AND[/TD]
[/TR]
[TR]
[TD]PQR CAN[/TD]
[/TR]
[TR]
[TD]So much traffic MO[/TD]
[/TR]
[TR]
[TD]ABC ends nothing[/TD]
[/TR]
[TR]
[TD]Canteen XYZ always[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
In Col AA onwards data spilt like this...
[TABLE="width: 302"]
<colgroup><col><col span="3"></colgroup><tbody>[TR]
[TD]BENEFITS[/TD]
[TD]DET[/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]ABC[/TD]
[TD]EMP[/TD]
[TD]Mango[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]Nature[/TD]
[TD]is[/TD]
[TD]Great[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]Mango[/TD]
[TD]PQR[/TD]
[TD]here[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]Lemmon[/TD]
[TD]here[/TD]
[TD]XYZ[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]where[/TD]
[TD]LEO[/TD]
[TD]AND[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]PQR[/TD]
[TD]CAN[/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]So[/TD]
[TD]much[/TD]
[TD]traffic[/TD]
[TD]MO[/TD]
[/TR]
[TR]
[TD]ABC[/TD]
[TD]ends[/TD]
[TD]nothing[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]Canteen[/TD]
[TD]XYZ[/TD]
[TD]always[/TD]
[TD] [/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
In Col Z, I have Unique values...
[TABLE="width: 64"]
<colgroup><col width="64" style="width:48pt"> </colgroup><tbody>[TR]
[TD="width: 64"]ABC[/TD]
[/TR]
[TR]
[TD]MO[/TD]
[/TR]
[TR]
[TD]XYZ[/TD]
[/TR]
[TR]
[TD]PQR[/TD]
[/TR]
[TR]
[TD]LEO[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
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...
 
Upvote 0
Wrong
 
Last edited:
Upvote 0
Try
Code:
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
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,333
Members
452,636
Latest member
laura12345

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