CODEWITHSUNDEEP
excelvba
John L
John L

Reputation: 11

Find value in another sheet and return value to the right

I want to take the active cell in the For Each, "vlookup" it in another sheet, and bring back the value from the cell to the right of it.

The problem is in .find(cell.value).

Option Explicit

Sub EmailRep()

    Dim range1, range2, cell As Range
    Dim ult_email As String
    Dim ult_linha As Integer
    Dim linha_atual As Integer
    Dim Email_atual As String

    Set range2 = Sheets("Planilha1").Range("B2:B21")
    Set range1 = Range("D4:D19")
    
    linha_atual = range1.Cells(1, 1).Row
    ult_linha = 19
    ult_email = Email_atual
    Email_atual = ult_email
    
    For Each cell In range1

        If cell.Value <> ult_email Then
            Email_atual = cell.Value
            ult_email = cell.Value
            
        Else
            cell.Value = range2.Find(cell.Value).Offset(1, 1)
            MsgBox (cell)
            
        End If
    
        linha_atual = linha_atual + 1
    
    Next
End Sub

enter image description here enter image description here

Upvotes: 1

Views: 171

Answers (1)

VBasic2008
VBasic2008

Reputation: 54777

A VBA Lookup (Loop, Dictionary)

  • This may not be what you need but check it out. It will return the unique column pairs of one two-column range in another worksheet's two-column range.
  • Adjust (play with) the values in the constants section (a second worksheet name was never mentioned).
Option Explicit

Sub EmailRep()

    ' Source (Read)
    Const sName As String = "Planilha1"
    Const sfCol As String = "A"
    Const sfRow As Long = 2
    ' Destination (Write)
    Const dName As String = "Planilha2"
    Const dfCol As String = "D"
    Const dfRow As Long = 4
    Const DoClearBelow As Boolean = True
    Const DoSort As Boolean = True
    ' Both
    Const Delimiter As String = "|" ' something that doesn't appear in the data
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code

    ' Reference the source range.
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, sfCol).End(xlUp).Row
    Dim srg As Range: Set srg = sws.Range( _
        sws.Cells(sfRow, sfCol), sws.Cells(slRow, sfCol)).Resize(, 2)
    
    ' Write from the source range to the dictionary.
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    Dim srrg As Range
    Dim sString As String
    For Each srrg In srg.Rows ' loop through rows
        sString = srrg.Cells(1) & Delimiter & srrg.Cells(2)
        dict(sString) = Empty
    Next srrg
    Dim rCount As Long: rCount = dict.Count
    
    Application.ScreenUpdating = False
    
    ' Write from the dictionary to the destination range.
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    Dim drg As Range: Set drg = dws.Cells(dfRow, dfCol).Resize(rCount, 2)
    Dim Key As Variant
    Dim r As Long
    For Each Key In dict.Keys
        r = r + 1
        drg.Rows(r).Value = Split(Key, Delimiter)
    Next Key
    
    ' Clear below.
    If DoClearBelow Then
        drg.Resize(dws.Rows.Count - drg.Row - rCount + 1).Offset(rCount).Clear
    End If
    ' Sort.
    If DoSort Then drg.Sort drg.Columns(1), xlAscending
    
    Application.ScreenUpdating = True
    
    MsgBox "Data created.", vbInformation
    
End Sub

Upvotes: 1

Related Questions