Comparing Three Columns and Copy Pasting data

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

• Pavlo Slavynskyy: What's the size of data?
• Rajput: Its more than 10,000.
• Greedo: Could you give a sample of the data please? As @PavloSlavynskyy points out, VBA might not be the best option here for performance
• Rajput: Sure please here is the File @Greedo
• Greedo: @Valiant actually l meant if you could add this info to the question, perhaps as a markdown table? Also you haven't included sheet3. Are your tables formatted as real Excel tables? (NB you can create md tables from Excel automatically)

Answer 1

Lookup by Comparing Multiple Columns (Array Loop)

Intro

• Although I would agree with most of Pavlo Slavynskyy's points (the screen updating is kind of debatable since you're using the fast 'copy-by-assignment method' i.e. dCell.Value = sCell.Value, but it's good to know about it; and I have almost never used VLookup since there is the less restricting, brilliant Application.Match), you have made a crucial mistake with the loops. But let's keep it slow.

The Workbook

• Your worksheets are not qualified i.e. they 'point' ('belong') to the ActiveWorkbook which could be any workbook.

• Try the following experiment:

  • In Excel, open your workbook.
  • Open a new workbook.
  • Go to the Visual Basic Editor and run your code.
  • It will try to find the worksheets in the new workbook and probably raise
    Run-time error '9': Subscript out of range.

• In VBA, to reference the workbook containing this code, you use ThisWorkbook:

  Dim wb As Workbook: Set wb = ThisWorkbook
  

• Since you're dealing with just one workbook, wb is just fine. No need for additional characters.

The Worksheets

• First of all, I love ws but only if there is only one worksheet. Using ws and ws2 is kind of confusing, which is which? Where am I reading from and where am I writing to?
• I've adopted a Source-Destination concept, so I will use sws for the source and dws for the destination worksheets. You can create your own concept but you should be consistent about it.
• From the line ws2.Cells(j, 120).Value = ws.Cells(j, 18).Value it is obvious that ws2 is you r Destination worksheet (dws) and ws is your Source worksheet (sws).

Efficiency: If Statement

• If you write an If statement in one line e.g. ...

  If A = 0 And B = 0 And C = 0 Then 
  

  ... you have shortened the code, but on each loop, the code evaluates all three expressions, even if already A or B is not 0. For this simple example, there will be no practical difference in the efficiency but keep it in mind when you'll have more complex expressions.

Efficiency: The Mistake

• To make the code more efficient, you want to access (read from, especially write to) the worksheets as few times as possible, but your loops do the opposite.

• Firstly, you don't want to first loop through the rows in the columns of the source worksheet because you are trying to write to ('to fill') the cells of the destination worksheet.

• Secondly, now when you loop through the rows in the columns of the destination worksheet when a value (in this case 3 values are matched) is found, you don't need to loop any longer (it's found), so use Exit For:

  If Something Then ' e.g. value found
   Do Whatever
   Exit For ' stop looping
  End If 
  

  ... to exit the loop.

The Split Function

• When you have a list in a string, e.g.,...

  Dim sNamesList As String: sNamesList = "John,Peter,Mary"
  

  ... you can easily write the values to an array using the Split function ...

  Dim sNames() As String: sNames = Split(sNamesList, ",")
  

  ... but be careful, any spaces inside will not be truncated.

• The resulting array is always a (1D) zero-based array.

Efficiency: Using Arrays

• By introducing arrays into your code, you will reduce accessing the worksheets to the minimum.

• You can read each range into an array (in one go) as simple as:

   Dim rg As Range: Set rg = Range("A1:A10")
   Dim Data As Variant: Data = rg.Value
  

• In this case, the expression rg.Value alone is (has created) already a 2D one-based array with ten rows and one column containing the values of the range.

• Note that this is not true if the range contains only one cell (see the GetRange function for details).

• Knowing this, you can now loop through the elements of the arrays (in memory) instead of the cells of the worksheet and vastly improve the performance of the code.

• Similarly, you can write the values of a 2D one-based array to the worksheet in one go:

   Dim rg As Range: rg.Resize(Ubound(Data, 1), Ubound(Data, 2)).Value = Data
  

  ... or in our case, since there is only one column per 2D array, you can simplify:

   Dim rg As Range: rg.Resize(Ubound(Data, 1)).Value = Data
  

Readability

• To make the code more readable you can create your helper procedures which you may use in some other projects, e.g. RefColumn and GetRange.

Miscellaneous

• The code is written according to your posted code.
• To use it in your provided sample file, change the following:
  • "Sheet3" to "Sheet2"
  • "R" to "Q"
  • "Sheet2" to "Sheet1"

The Main Code

Option Explicit
Sub LookupMultiColumnsCompare()
 
 Const ProcTitle As String = "Lookup Multi Columns Compare"
 ' Source
 Const sName As String = "Sheet3"
 Const sFirst As String = "N3"
 Const scColsList As String = "N,O,P" ' 14, 15, 16 add more (or less)
 Const svCol As String = "R" ' 18
 ' Destination
 Const dName As String = "Sheet2"
 Const dFirst As String = "CT3"
 Const dcColsList As String = "CT,CY,DJ" ' 98, 103, 114 ' add more
 ' *** Triple-check the following because in this column the data
 ' will be overwritten! Remember, there is no undo.
 Const dvCol As String = "DP" ' 120
 
 ' Create a reference to the workbook containing this code ('ThisWorkbook').
 Dim wb As Workbook: Set wb = ThisWorkbook
 
 Dim WasSuccessful As Boolean
 Dim n As Long ' Compare Columns Arrays Counter (Source, Destination, Loop)
 
 On Error GoTo ClearError
 
 ' Source
 
 Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
 Dim sfCell As Range: Set sfCell = sws.Range(sFirst)
 Dim srg As Range: Set srg = RefColumn(sfCell)
 If srg Is Nothing Then Exit Sub ' no data
 
 Dim srCount As Long: srCount = srg.Rows.Count
 Dim scCols() As String: scCols = Split(scColsList, ",")
 Dim nUpper As Long: nUpper = UBound(scCols)
 
 Dim sData As Variant: ReDim sData(0 To nUpper)
 
 For n = 0 To nUpper
 sData(n) = GetRange(srg.EntireRow.Columns(scCols(n)))
 Next n
 Dim svData As Variant: svData = GetRange(srg.EntireRow.Columns(svCol))
 
 ' Destination
 
 Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
 Dim dfCell As Range: Set dfCell = dws.Range(dFirst)
 Dim drg As Range: Set drg = RefColumn(dfCell)
 If drg Is Nothing Then Exit Sub ' no data
 
 Dim drCount As Long: drCount = drg.Rows.Count
 Dim dcCols() As String: dcCols = Split(dcColsList, ",")
 
 Dim dData As Variant: ReDim dData(0 To nUpper)
 
 For n = 0 To nUpper
 dData(n) = GetRange(drg.EntireRow.Columns(dcCols(n)))
 Next n
 Dim dvData As Variant: ReDim dvData(1 To drCount, 1 To 1)
 ' You could speed up the code if the values will always stay the same
 ' once they are written i.e. if you already have found the matches
 ' the first time and you don't need to modify them, by rather reading
 ' the 'Value' column range into the array.
 ' Instead of the previous line use the following...
 'Dim dvData As Variant: dvData = GetRange(drg.EntireRow.Columns(dvCol))
 ' ... and test the value of each item in the array before looping further
 ' by adding a new 'If' statement below the line 'For dr = 1 To drCount':
 ' 'If Len(dvData(dr, 1)) = 0 Then"'. Don't forget about its 'End If'.
 
 ' Loop
 
 Dim sValue As Variant
 Dim sr As Long
 
 Dim dCell As Range
 Dim dValue As Variant
 Dim dr As Long
 
 For dr = 1 To drCount
 For sr = 1 To srCount
 For n = 0 To nUpper
 dValue = dData(n)(dr, 1)
 ' Dependent on your data, some of the following 'If' statements
 ' may be redundant but they should slow down the code,
 ' so think twice before removing (uncommenting) them.
 If IsError(dValue) Then Exit For ' exclude error values
 If Len(dValue) = 0 Then Exit For ' exclude blanks
 sValue = sData(n)(sr, 1)
 If IsError(sValue) Then Exit For ' exclude error values
 If IsDate(sValue) Then
 If IsDate(dValue) Then
 ' The tricky date part when it contains time.
 If Round(CDbl(sValue), 6) <> Round(CDbl(sValue), 6) Then
 Exit For
 End If
 End If
 Else
 If sValue <> dValue Then Exit For
 End If
 
 Next n
 ' Note that if the loop was not interrupted, 'n = nUpper + 1'.
 If n > nUpper Then
 dvData(dr, 1) = svData(sr, 1)
 End If
 Next sr
 Next dr
 
 ' Overwrite the values in destination with values in the array.
 Dim dvrg As Range: Set dvrg = drg.EntireRow.Columns(dvCol)
 dvrg.Value = dvData
 
 WasSuccessful = True
 
InfoExit:
 If WasSuccessful Then
 MsgBox "Worksheet successfully updated.", _
 vbInformation, ProcTitle
 Else
 MsgBox "Something went wrong." & vbLf _
 & "Double-check the values in the constants section of the code.", _
 vbCritical, ProcTitle
 End If
 Exit Sub
ClearError:
 Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
 Resume InfoExit
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

Some Toys

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns the Excel column string from a (column) number.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetColumnString( _
 ByVal ColumnNumber As Long) _
As String ' only '-2147483648#' crashes it!?
 
 Dim Remainder As Long
 Do
 Remainder = (ColumnNumber - 1) Mod 26
 GetColumnString = Chr(Remainder + 65) & GetColumnString
 ColumnNumber = Int((ColumnNumber - Remainder) \ 26)
 Loop Until ColumnNumber = 0
End Function
Sub GetColumnStringTEST()
 Debug.Print GetColumnString(120)
 Debug.Print GetColumnString(16384) ' max for 'Excel'
 Debug.Print GetColumnString(2147483647) ' max for 'Long'
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns the Excel column number from a (column) string.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetColumnNumber( _
 ByVal ColumnString As String) _
As Long
 On Error GoTo ClearError ' too many chars: "Run-time error '6': Overflow"
 
 Dim ColumnStringLength As Long: ColumnStringLength = Len(ColumnString)
 
 Dim n As Long
 Dim CharNumber As Long
 Dim CharIndex As Long
 Dim ColumnNumber As Long
 For n = ColumnStringLength To 1 Step -1
 CharNumber = Asc(UCase(Mid(ColumnString, n))) - 64
 If CharNumber >= 1 Then
 If CharNumber <= 26 Then
 ColumnNumber = ColumnNumber + CharNumber * 26 ^ CharIndex
 CharIndex = CharIndex + 1
 End If
 End If
 Next
 GetColumnNumber = ColumnNumber
ProcExit:
 Exit Function
ClearError:
 Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
 Resume ProcExit
End Function
Sub GetColumnNumberTEST()
 Debug.Print GetColumnNumber("DP")
 Debug.Print GetColumnNumber("XFD") ' max for 'Excel'
 Debug.Print GetColumnNumber("FXSHRXW") ' max for 'Long'
End Sub

• Toby Speight: You have presented an alternative solution, but haven't reviewed the code. Please edit to show what aspects of the question code prompted you to write this version, and in what ways it's an improvement over the original. It may be worth (re-)reading How to Answer.
• VBasic2008: @Toby Speight: Thanks for pointing that out. I never read it on this site. I will edit my answer ASAP, possibly tomorrow.

Answer 2

Indents

Always keep the code properly indented. You'll spend much more time fixing some stupid error caused by improperly indented code then you'll save on not indenting it. This code looks like the only line in For i loop is a = ws.Cells(i, 14).Value, but in fact all the code except for the final line is in this loop. Don't make readers struggle to read the code.

Variable names

a, b and c are bad names. If you know what kind of data is in those columns - please, name them according to the content - like name, lastName and dateOfBirth.

Magic numbers

What are 14, 15, 98, 114? Some cells indices? What if you'll change something in the file - are you going to redo all the code because of that? Creating constants will allow you to make the code more flexible:

Const wsStartRow As Integer = 3
Const wsEndCellCol As Integer = 14
...
For i = wsStartRow To ws.Cells(ws.Rows.Count, wsEndCellCol).End(xlUp).Row

Stop screen updates

Well, that's the cause of your problem: the screen updates when you change values, and screen updates are slow. You can easily stop it:

Application.ScreenUpdating = False

and don't forget to turn it in the end:

Application.ScreenUpdating = True

Other ways

You can concatenate values in the cells into a new column to make use of built-in functions like VLOOKUP.

• Rajput: Thank you very much for elaborating and highlighting my mistakes. I used your way but the problem is still same.