Defining the end of the Range with last cell with a value instead of the row number - excel

Question

I use two data dumps which are saved in OPL_Dump and OPL_DUMP_2 sheets.
The code I am trying to improve, finds the data in one of the dumps and copies and pastes as a new parameter as addition to the same corresponding value it sees for the other dump.
The length of both the data dumps varies. I manually amend the length of the range every time.
I am trying to make my code a bit more robust
I tried defining N and L instead of fixed numbers of last rows.
Sub Merging_Both_Dumps_for_Product_Type()
Dim out() As String
'Dim out2() As String
L As Long
L = ThisWorkbook.Sheets("OPL_DUMP_2").Select.Cells(Rows.Count, "B").End(xlUp).Row
ThisWorkbook.Sheets("OPL_DUMP_2").Select
keyarray = Range("F" & 2 & ":F" & L)
valuearray = Range("J" & 2 & ":J" & L)
N As Long
N = ThisWorkbook.Sheets("OPL_DUMP").Select.Cells(Rows.Count, "B").End(xlUp).Row
ReDim out(N, 0)
For j = 2 To N
ind = Index(keyarray, ThisWorkbook.Sheets("OPL_DUMP").Cells(j, 2).Value)
out(j - 2, 0) = valuearray(ind, 1)
Next j
'ReDim out2(1, 0)
'out2(1, 0) = "test"
'ThisWorkbook.Sheets("OPL_DUMP").Range("AD2:AD3") = out2()
ThisWorkbook.Sheets("OPL_DUMP").Range("AC" & 2 & ":AC" & N) = out
End Sub

Answer 1

Try this code, should work fine, fast and always no matter the size of your dumps:
Option Explicit
Sub Merging_Both_Dumps_for_Product_Type()
'You need the reference Microsoft Scripting Runtime
'under tools-references activated for this code to work.
Dim output_values As Dictionary
Set output_values = load_output_values(ThisWorkbook.Sheets("OPL_DUMP_2").UsedRange.Value)
'Store your output worksheet inside an array
Dim arr As Variant: arr = ThisWorkbook.Sheets("OPL_DUMP").UsedRange.Value
'loop through the array
Dim i As Long
For i = 2 To UBound(arr)
'check if the value in col B exists in the dictionary
If output_values.Exists(arr(i, 2)) Then
arr(i, 29) = output_values(arr(i, 2))
End If
Next i
'paste back the array to the worksheet
ThisWorkbook.Sheets("OPL_DUMP").UsedRange.Value = arr
'Note that using worksheet.usedrange.value will store
'everything in the sheet that has been used, even if its blank
'meaning if you do ctrl+end in your keyboard, the array will be
'as big as A1: the cell where ctrl+end sends you.
End Sub
Private Function load_output_values(arr As Variant) As Dictionary
'this function will store in a dictionary each key (col F = index 2)
'with it's item (col J = index 10)
'Since we stored the sheet inside an array we can loop through it
Set load_output_values = New Dictionary ' init the dictionary
Dim i As Long
For i = 2 To UBound(arr)
'first check either column B is empty or already exists
'will take the first ocurrence if col B is duplicated.
If Not arr(i, 2) = vbNullString _
And Not load_output_values.Exists(arr(i, 2)) Then
load_output_values.Add arr(i, 2), arr(i, 10)
End If
Next i
End Function

Answer 2

Lookup Data Using Application.Match
Option Explicit
Sub LookupData()
' 1. Define constants.
' Source
Const sName As String = "OPL_DUMP_2"
Const skCol As String = "F" ' 2. ... lookup the key...
Const svCol As String = "J" ' 3. ... read the associated value...
Const sfRow As Long = 2
' Destination
Const dName As String = "OPL_DUMP"
Const dkCol As String = "B" ' 1. Read the key...
Const dvCol As String = "AC" ' 4. ... write the value.
Const dfRow As Long = 2
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' 2. Reference the source key (one-column) range ('skrg')
' and write the values from the source value (one-column) range ('svrg')
' to a 2D one-based (one-column) array ('svData').
' We will use 'skrg' because 'Application.Match' is faster on a range.
' We will use 'svData' because reading from an array is faster than
' from a range.
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, skCol).End(xlUp).Row
Dim srCount As Long: srCount = slRow - sfRow + 1
If srCount < 1 Then
MsgBox "No data in column range.", vbCritical
Exit Sub
End If
Dim skrg As Range: Set skrg = sws.Cells(sfRow, skCol).Resize(srCount)
' ... which is the same as:
'Set skrg = sws.Range(sws.Cells(sfRow, skCol), sws.Cells(slrow, skCol))
Dim svrg As Range: Set svrg = skrg.EntireRow.Columns(svCol)
Dim svData() As Variant
If srCount = 1 Then ' one cell
ReDim svData(1 To 1, 1 To 1): svData(1, 1) = svrg.Value
Else ' multiple cells
svData = svrg.Value
End If
' 3. Reference the destination key (one-column) range ('skrg')
' and write its values the to a 2D one-based (one-column) array,
' the destination keys array ('dkData').
' We will use 'dkData' because reading from an array is faster than
' from a range.
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
Dim dlRow As Long: dlRow = dws.Cells(dws.Rows.Count, dkCol).End(xlUp).Row
Dim drCount As Long: drCount = dlRow - dfRow + 1
If drCount < 1 Then
MsgBox "No data in column range.", vbCritical
Exit Sub
End If
Dim dkrg As Range: Set dkrg = dws.Cells(dfRow, dkCol).Resize(drCount)
' ... which is the same as:
'Set dkrg = dws.Range(dws.Cells(dfRow, dkCol), dws.Cells(dlrow, dkCol))
Dim dkData() As Variant
If drCount = 1 Then ' one cell
ReDim dkData(1 To 1, 1 To 1): dkData(1, 1) = dkrg.Value
Else ' multiple cells
dkData = dkrg.Value
End If
' 3. Write the matching values to the destination values array ('dvData'),
' a 2D one-based one-column array, with the same number of rows
' as the number of rows of the destination keys array.
Dim dvData() As Variant: ReDim dvData(1 To drCount, 1 To 1)
Dim sr As Variant
Dim dValue As Variant
Dim dr As Long
For dr = 1 To drCount
dValue = dkData(dr, 1)
sr = Application.Match(dValue, skrg, 0)
If IsNumeric(sr) Then ' is a number (the row index)
dvData(dr, 1) = svData(sr, 1)
'Else ' is an error value (no match); do nothing
End If
Next dr
' 4. Write the values from the destination values array
' to the destination values range ('dvrg').
Dim dvrg As Range: Set dvrg = dkrg.EntireRow.Columns(dvCol)
dvrg.Value = dvData
' Save the workbook.
'wb.Save
' 5. Inform.
MsgBox "Lookup has finished.", vbInformation
End Sub