Nested loop confusion

[Tim Hanson]

Hi,

I am struggling to create the nested loop my first.

I need to assign the ID value to the cell in the source column when it matches the cell value in the email column.

i.e from the email column the first cell value is bobjohnson@email.com his ID value is 0 I need to find all the cells with bobjohnson@email.com in the Source column and assign them 0

I know my code is a mish-mash of stuff, but after hour of tiring am hoping for some help.

Thank you

Sub Source()
    Application.ScreenUpdating = False
    Dim i As Integer
    Dim lrow As Long
    Dim Myfind As String
    Dim Idvalue As String
    Dim firstaddress As String
    Dim c
    lrow = Sheets("Sheet2").Range("C65336").End(xlUp).Row
    With Worksheets(2)
        For i = 1 To lrow
            Myfind = Cells(i, 3).Text
            Idvalue = Cells(i, 2).Value
            Set c = Range("A:A").Find(Myfind, LookIn:=xlValues)
            If Not c Is Nothing Then
                firstaddress = c.Address
                Do
                    Range("MyFind").Select
                    ActiveCell.FormulaR1C1 = Idvalue
                    Set c = Range("A:A").FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstaddress
            End If
        Next i
    End With

    End Sub

Original File

    email                     ID   Source
    bobjohnson@email.com      0    pollypots@email.com
    bobjohnson@email.com      0    juanalvarez@email.com
    frankcarpet@email.com     1    bettysue@email.com
    juanalvarez@email.com     2    bobjohnson@email.com
    juanalvarez@email.com     2    bettysue@email.com
    sallybersong@email.com    3    Juanalvarez@email.com
    sallybersong@email.com    3    yaraflowers@email.com
    pollypots@email.com       4    yaraflowers@email.com
    yaraflowers@email.com     5    juanalvarez@email.com
    yaraflowers@email.com     5    pollypots@email.com
    yaraflowers@email.com     5    bobjohnson@email.com
    yaraflowers@email.com     5    bettysue@email.com
    bettysue@email.com        6    yaraflowers@email.com

Results File

    email                    ID  Source
    bobjohnson@email.com      0    4
    bobjohnson@email.com      0    2
    frakkcarpet@email.com    1    6
    juanalvarez@email.com    2    0
    juanalvarez@email.com    2    6
    sallybersong@email.com    3    2
    sallybersong@email.com    3    5
    pollypots@email.com      4    5
    yaraflowers@email.com    5    2
    yaraflowers@email.com    5    4
    yaraflowers@email.com    5    0
    yaraflowers@email.com    5    6
    bettysue@email.com        6    5

 

[NARAYANK991]

Hi Tim ,

See this file.

Narayan

 

[KenU]

Tim,

I was in the process of writing some code when I saw another post go up. I am attaching the code anyway in case you or someone else may find it useful.

I have included some comments to help explain the code, but there is another requirement (or assumption). I suggest that you create a list of unique entries for relating each email address to an ID. This can be done by selecting those two columns and using advanced filter's options to "copy to another location" and "Unique values only". That will allow the code below to replace all occurrences of each address in one pass using the Replace method (instead of Find) in VBA.

Sub FindReplace()
Dim wA As Workbook
Dim sFR As Worksheet                '** ASSUMES YOUR LIST AND DATA ARE ON THE SAME SHEET
Dim rFR As Range
Dim rData As Range

Set wA = ActiveWorkbook
Set sFR = wA.Worksheets("Sheet2")   '** SHEET NAME FOR DATA AND LIST OF EMAIL ADDRESSES/CODES
Set rFR = sFR.Range("AA2:AB20")     '** EDIT THIS TO MATCH LOCATION OF YOUR LIST
Set rData = sFR.Range("C:C")        '** COLUMN FOR FIND/REPLACE

Do While Not IsEmpty(rFR)
    rData.Replace rFR.Cells(1, 1), rFR.Cells(1, 2)
    Set rFR = rFR.Cells(2, 1)
Loop

End Sub

Hope that helps.

Ken

 

[Luke M]

You were pretty close. I think the main thing is that you are actually using col A as the "MyFind", not col C, which is slowly getting overwritten.

Sub Source()
    Application.ScreenUpdating = False
    Dim i As Integer
    Dim lrow As Long
    Dim Myfind As String
    Dim Idvalue As String
    Dim firstAddress As String
    Dim c

    With Worksheets(2)
    lrow = .Range("C65336").End(xlUp).Row
        For i = 2 To lrow
            Myfind = .Cells(i, 1).Text
            Idvalue = .Cells(i, 2).Value
            Set c = .Range("C:C").Find(Myfind, LookIn:=xlValues)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    c.Value = Idvalue
                    Set c = .Range("C:C").FindNext(c)
                Loop While Not c Is Nothing 
            End If
        Next i
    End With

End Sub

EDIT: and now I see that several other people have come up with solutions as well.

 

[Tim Hanson]

Thank you ALL, it is instructive to see how Narayan and Luke M fixed my code with slight variations and the different approach by KenU.