Find and paste values from one sheet to another in selected columns - excel

Question

I am trying to paste values from one sheet into another, both sheets have one unique column B "Bill ID".
I enter values in column p, q and w of sheet "reconciliation".
When I run the code it should paste these values in column p, q, w of bills sheet against same Bill ID, Bill ID in both sheets is in column 2.
One more thing, from reconciliation sheet for Bill ID, it should search only from b21 to last non empty row.
Dim wb As Workbook: Set wb = ThisWorkbook
Dim wsDisp As Worksheet: Set wsDisp = wb.Worksheets("Reconciliation")
Dim a As String
Dim b As String
Dim c As String
Dim e As Long
Dim F As String
Application.ScreenUpdating = False
a = wsDisp.Cells(19, 16).Value
b = wsDisp.Cells(19, 17).Value
c = wsDisp.Cells(19, 23).Value
e = MsgBox("Do You Wish to Save Recovery ? " & vbNewLine & "GIDC PAID = " & a & vbNewLine & "GST PAID = " & b & vbNewLine & " LPS PAID = " & c, vbYesNo)
If e = vbNo Then Exit Sub
For i = 21 To 400
Sheets("Bills").Cells(Cells(i, 2), 16) = Sheets("Reconciliation").Cells(i, 16)
Sheets("Bills").Cells(Cells(i, 2), 17) = Sheets("Reconciliation").Cells(i, 17)
Sheets("Bills").Cells(Cells(i, 2), 23) = Sheets("Reconciliation").Cells(i, 23)
Next
Application.ScreenUpdating = True
Reconciliation Sheet
Bills

Answer 1

Update Cells in Matching Rows
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Updates the 'Bills' worksheet.
' Calls: 'RefColumn','GetRange'.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub UpdateBills()
' Source
Const sName As String = "Reconciliation"
Const sfRow As Long = 21
Const suCol As String = "B"
Const sColsList As String = "P,Q,W"
' Destination
Const dName As String = "Bills"
Const dfRow As Long = 2
Const duCol As String = "B"
Const dColsList As String = "P,Q,W"
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook
' Create references to the read-columns ('surg' and 'durg')
' and write only destination column to an array ('duData').
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim surg As Range: Set surg = RefColumn(sws.Cells(sfRow, suCol))
If surg Is Nothing Then Exit Sub ' no data
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
Dim durg As Range: Set durg = RefColumn(dws.Cells(dfRow, duCol))
If durg Is Nothing Then Exit Sub ' no data
' This is not done for the source because 'Application.Match'
' is multiple times faster on a range.
Dim duData As Variant: duData = GetRange(durg)
' Write values from the write-columns to jagged arrays.
' Split the lists (comma-separated strings) to arrays.
Dim sCols() As String: sCols = Split(sColsList, ",")
Dim dCols() As String: dCols = Split(dColsList, ",")
Dim cUpper As Long: cUpper = UBound(sCols)
' Define the jagged arrays.
Dim sData As Variant: ReDim sData(0 To cUpper)
Dim dData As Variant: ReDim dData(0 To cUpper)
' Define destination empty array ('drData').
Dim drCount As Long: drCount = UBound(duData, 1)
Dim drData As Variant: ReDim drData(1 To drCount, 1 To 1)
Dim c As Long
' Write values from the source write-columns to the source jagged array,
' and destination empty arrays to destination jagged array.
For c = 0 To cUpper
sData(c) = GetRange(surg.EntireRow.Columns(sCols(c)))
dData(c) = drData
Next c
Erase drData
' Write matches from source (jagged) array ('sData')
' to destination (jagged) array ('dData').
Dim dr As Long
Dim sIndex As Variant
For dr = 1 To drCount
sIndex = Application.Match(duData(dr, 1), surg, 0)
If IsNumeric(sIndex) Then
For c = 0 To cUpper
dData(c)(dr, 1) = sData(c)(sIndex, 1)
Next c
End If
Next dr
Erase duData
Erase sData
' Write values from destination array tp destination ranges.
For c = 0 To cUpper
durg.EntireRow.Columns(dCols(c)).Value = dData(c)
Next c
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Creates a reference to the one-column range from the first cell
' of a range ('FirstCell') to the bottom-most non-empty cell
' of the first cell's worksheet column.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefColumn( _
ByVal FirstCell As Range) _
As Range
If FirstCell Is Nothing Then Exit Function
With FirstCell.Cells(1)
Dim lCell As Range
Set lCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If lCell Is Nothing Then Exit Function
Set RefColumn = .Resize(lCell.Row - .Row + 1)
End With
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns the values of a range ('rg') in a 2D one-based array.
' Remarks: If ˙rg` refers to a multi-range, only its first area
' is considered.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetRange( _
ByVal rg As Range) _
As Variant
If rg Is Nothing Then Exit Function
If rg.Rows.Count + rg.Columns.Count = 2 Then ' one cell
Dim Data As Variant: ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
GetRange = Data
Else ' multiple cells
GetRange = rg.Value
End If
End Function