Do Until LOOP Help

[rockchalk33]

Geniuses,

I am having a bit of trouble getting a piece of code to loop. I have a button that once clicked will do exactly this:




If Duplicate_Find Is Nothing Then
ActiveCell.Copy
ActiveCell.Offset(0, 2).Select
ActiveCell.PasteSpecial
ActiveCell.Offset(1, -2).Select
Else: ActiveCell.Offset(1, 0).Select
End If




I need this to start on Range ("A6") and loop until the first cell that is empty.

This is the code I tried:




Public Button1_Click()

Range ("A5").Select
Do Until IsEmpty (ActiveCell)
ActiveCell.Offset (1,0)
If Duplicate_Find Is Nothing Then
ActiveCell.Copy
ActiveCell.Offset(0, 2).Select
ActiveCell.PasteSpecial
ActiveCell.Offset(1, -2).Select
Else: ActiveCell.Offset(1, 0).Select
End If
Loop

End Sub






Every time I click Button_1 it automatically jumps down to the first empty cell and never copied any data over.

Any help would be appreciated, should be an easy fix.

Thanks all!

Devin

 

[My Aswer Is This]

Try and explain what you want this script to do:
I do not understand:
If Duplicate_Find Is Nothing Then

 

[rockchalk33]

Try and explain what you want this script to do:
I do not understand:
If Duplicate_Find Is Nothing Then

Duplicate_Find is searching a a given range for the same value represented by the ActiveCell.

 

[My Aswer Is This]

What is the range you want to search.
So if the exact value in the activecell is found any where else in the given range you want the value in the cell copied over to the cell two columns to the right. is this correct?

 

[mikerickson]

I would avoid using the ActiveCell and use a Range variable.

Dim oneCell as Range

Set oneCell = Range("A6")
   
Do Until oneCell.Value = vbNullString

    If Duplicate_Find Then
        With oneCell.Offset(0,2)
            .Value = oneCell.Value
            Set oneCell = .Cells
        End With
    End If

    Set oneCell = oneCell.Offset(1, 0)
Loop

Like My Answer Is This, I'd like to see the code for Duplicate_Find. It might also benefit from not selecting.

 

[rockchalk33]

Yes this is correct! Sorry for the late response!

 

[rockchalk33]

What is the range you want to search.
So if the exact value in the activecell is found any where else in the given range you want the value in the cell copied over to the cell two columns to the right. is this correct?

This is correct! I am just having a hard time finding a solution.

 

[mikerickson]

Can you please post the code for the Duplicate_Find routine?

 

[rockchalk33]

I would avoid using the ActiveCell and use a Range variable.

Dim oneCell as Range

Set oneCell = Range("A6")
   
Do Until oneCell.Value = vbNullString

    If Duplicate_Find Then
        With oneCell.Offset(0,2)
            .Value = oneCell.Value
            Set oneCell = .Cells
        End With
    End If

    Set oneCell = oneCell.Offset(1, 0)
Loop

Like My Answer Is This, I'd like to see the code for Duplicate_Find. It might also benefit from not selecting.

Mike, I believe this is the right direction but I am still stuck.

Here is the code for Duplicate_Find:

Dim Search_Range As Range
Set Search_Range = Range ("C:DL")

Dim Duplicate_Find as Range
Set Duplicate_Find = Search_Range.Find(What:=ActiveCell.Value, MatchCase:=True, LookAt:=xlWhole)


In essence I want to go down column A and if the value in column A is also found in the Search_Range, I want to copy and paste the value in A directly into column B on the same row.

Thanks for your help all!

 

[JackDanIce]

It's still not entirely clear what you want, but as a guess, try:

Dim SrchMacro()

    Dim x       As Long
    Dim rng     As range
    Dim rngF    As range
    Dim rngSrc  As range
    Dim rngArea As range
    
    Application.ScreenUpdating = False
    
    Set rngArea = range("C:DL")
    
    x = Cells(rows.count, 1).End(xlUp).row
    
    Set rngSrc = range("A6").Resize(x-5)
    
    For Each rng In rngSrc
        With rng
            Set rngF = rngArea.find(what:=.value, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True)
            
            If Not rngF Is Nothing Then
                .Offset(, 1).value = .value
                Set rngF = Nothing
            End If
        End With
    Next rng
    
    Application.ScreenUpdating = True
    
    Set rngSrc = Nothing
    Set rngArea = Nothing
    
End Sub