Comparing Three Columns and Copy Pasting data - excel

Question

I am using below code which is comparing three columns values and copy pasting the 4th column data into other column.
My code is working fine but it is slow to perform the processing and takes much time and sometimes Not Responding window appears.
Any help to fix the problem will be appreciated
Sub rowMatch()
Dim ws As Worksheet
Dim ws2 As Worksheet
Set ws = Worksheets("Sheet3")
Set ws2 = Worksheets("Sheet2")
Dim a As String, b As String, c As Date
For i = 3 To ws.Cells(ws.Rows.Count, 14).End(xlUp).Row
a = ws.Cells(i, 14).Value
b = ws.Cells(i, 15).Value
c = ws.Cells(i, 16).Value
For j = 3 To ws2.Cells(ws2.Rows.Count, 98).End(xlUp).Row
If ws2.Cells(j, 98).Value = a _
And ws2.Cells(j, 103).Value = b _
And ws2.Cells(j, 114).Value = c _
Then
ws2.Cells(j, 120).Value = ws.Cells(j, 18).Value
End If
Next j
Next i
End Sub

Answer 1

A 'Triple' Lookup
When in a loop a condition 1. is not met or 2. is met, use Exit For to stop looping (to exit the loop).
Option Explicit
Sub TripleLookup()
' Source
Const sName As String = "Sheet3" ' Worksheet Name
Const sfRow As Long = 3 ' First Row
Const slColsList As String = "N,O,P" ' Lookup Columns
Const slrCol As String = "N" ' Last Row Column
Const svCol As String = "R" ' Value Column
' Destination
Const dName As String = "Sheet2" ' Worksheet Name
Const dfRow As Long = 3 ' First Row
Const dlColsList As String = "CT,CY,DJ" ' Lookup Columns
Const dlrcol As String = "CT" ' Last Row Column
Const dvCol As String = "DP" ' Value Column
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Source
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, slrCol).End(xlUp).Row
If slRow < sfRow Then Exit Sub ' no data
Dim srCount As Long: srCount = slRow - sfRow + 1
Dim slrrg As Range: Set slrrg = sws.Cells(sfRow, slrCol).Resize(srCount)
Dim slCols() As String: slCols = Split(slColsList, ",")
Dim cUpper As Long: cUpper = UBound(slCols)
Dim sData As Variant: ReDim sData(0 To cUpper)
Dim srg As Range
Dim n As Long
For n = 0 To cUpper
Set srg = slrrg.EntireRow.Columns(slCols(n))
sData(n) = srg.Value
Next n
Set srg = slrrg.EntireRow.Columns(svCol)
Dim svData As Variant: svData = srg.Value
' Destination
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
Dim dlRow As Long: dlRow = dws.Cells(dws.Rows.Count, dlrcol).End(xlUp).Row
If dlRow < dfRow Then Exit Sub ' no data
Dim drCount As Long: drCount = dlRow - dfRow + 1
Dim dlrrg As Range: Set dlrrg = dws.Cells(dfRow, dlrcol).Resize(drCount)
Dim dlCols() As String: dlCols = Split(dlColsList, ",")
Dim dData As Variant: ReDim dData(0 To cUpper)
Dim drg As Range
For n = 0 To cUpper
Set drg = dlrrg.EntireRow.Columns(dlCols(n))
dData(n) = drg.Value
Next n
Dim dvData As Variant: ReDim dvData(1 To drCount, 1 To 1)
' Loop
Dim tUpper As Long: tUpper = cUpper + 1
Dim sr As Long
Dim dr As Long
For dr = 1 To drCount
For sr = 1 To srCount
For n = 0 To cUpper
If StrComp(CStr(sData(n)(sr, 1)), CStr(dData(n)(dr, 1)), _
vbTextCompare) <> 0 Then ' ignoring case
Exit For ' 1. mismatch found, no need to loop anymore
End If
Next n
If n = tUpper Then ' no mismatch, all are equal
dvData(dr, 1) = svData(sr, 1)
Exit For ' 2. value written, no need to loop anymore
End If
Next sr
Next dr
' Result
Set drg = dlrrg.EntireRow.Columns(dvCol)
drg.Value = dvData
End Sub

Answer 2

Looking at the code you have two nested For loops, which depending on the size of the dataset you're working with, it will likely continue to be an issue on the time it takes to complete the task. The more rows you have, the longer it will take to complete the tasks.
One possible solution that you might want to consider looking into is using power query to blend/merge/append and clean data. Then use VBA to do what Power Query doesn't do very well.
I've spent many years avoiding looking at PQ as a solution to these problems and was a VBA guy all the way, but now when I come across these types of problems,I would look at PQ first over VBA.