CODEWITHSUNDEEP
vbaexcel
ELs
ELs

Reputation: 35

vba find value then paste another into different cell in another column

I'm currently running a Macro that looks for a value from column A of 'sheet 1' in column C of sheet 2, if these match then the value from column B of sheet 1 should be copied to column M of the corresponding row in sheet 2.

The Macro I have works, but because this is a massive worksheet, the loop in it is taking far too much time. This is because sheet 1 has around 300,000 rows and the value in each instance is unique. in Sheet 2 there are around 50,000 rows. It's been running overnight and has only reached 60,000 rows in sheet 1 so far

I'm by no means a VBA expert, or even intermediate but from what I've read maybe using Find would be faster than looking for a match and looping?

this is the macro i'm currently using

 Option Explicit

Sub lookupandcopy()
Application.Screenupdating = True

Dim j As Long, i As Long, lastRow1 As Long, lastRow2 As Long
Dim sh_1, sh_3 As Worksheet
Dim MyName As String

Set sh_1 = Sheets("sheet1") 
Set sh_3 = Sheets("sheet2")


lastRow1 = sh_1.UsedRange.Rows.Count 

For j = 2 To lastRow1
MyName = sh_1.Cells(j, 1).Value 


lastRow2 = sh_3.UsedRange.Rows.Count

For i = 2 To lastRow2
    If sh_3.Cells(i, 3).Value = MyName Then
        sh_3.Cells(i, 13).Value = sh_1.Cells(j, 2).Value 
    End If

    Next i

  Next j

Application.Screenupdating = True
End Sub

If I've missed anything off or any other detail that's needed please let me know!

Upvotes: 3

Views: 6245

Answers (1)

John Coleman
John Coleman

Reputation: 51988

You seem to be using columns A and B in sheet1 as a dictionary (and accessing the values by a linear search). Why not load the values into a dictionary objects which has O(1) search? Make sure that your project includes a reference to Microsoft Scripting Runtime (tools > references in the VBE if you haven't done such things) then try:

Sub lookupandcopy()
    Application.ScreenUpdating = False

    Dim AVals As New Dictionary
    Dim i As Long, j As Long, lastRow1 As Long, lastRow2 As Long
    Dim sh_1, sh_3 As Worksheet
    Dim MyName As String

    Set sh_1 = Sheets("sheet1")
    Set sh_3 = Sheets("sheet2")

    With sh_1
        lastRow1 = .Range("A:A").Rows.Count 'last row in spreadsheet
        lastRow1 = .Cells(lastRow1, 1).End(xlUp).Row 'last used row in column A
        'load the AVal dict
        For j = 2 To lastRow1
            MyName = .Cells(j, 1).Value
            If Len(MyName) > 0 Then AVals.Add MyName, .Cells(j, 2).Value
        Next j
    End With

    With sh_3
        lastRow2 = .Range("A:A").Rows.Count
        lastRow2 = .Cells(lastRow2, 3).End(xlUp).Row 'last used row in column 3
        For i = 2 To lastRow2
            MyName = .Cells(i, 3).Value
            If AVals.Exists(MyName) Then
                .Cells(i, 13).Value = AVals.Item(MyName)
            End If
         Next i
    End With
    Application.ScreenUpdating = True
End Sub

If you have repeated values in column A then you would need to do something like store as values collections of row indices where the value occurs, but the effort of setting up such a dictionary would still be better than using nested loops.

Upvotes: 1

Related Questions