Home » excel » excel – How to add corresponding value into right column (I have a code but its not fast enough)

excel – How to add corresponding value into right column (I have a code but its not fast enough)

Posted by: admin May 14, 2020 Leave a comment

Questions:

I’m using a ‘test excel’ to test my macro.
In my test excel, I have columns from A to F. I have to add a value to column F IF column A has a same value as column G has. Also I need to delete all the possible duplicates from the range from A to C. Here is an example:

 A  B  C  D  E  F      G  H
 1  2  2  2  2         1  work
 2  3  3  3  3         2  school
 2  3  3  3  3
 4  1  1  1  1

 After macro ----->

   One
A  B  C  D  E  F         G  H
1  2  2  2  2  work      1  work
2  3  3  3  3  school    2  school
4  1  1  1  1

So now, the list has been updated with values on Column F and deleted third row (because it was a duplicate).

This is what I have tried already. I dont know, how to do that macro checks column G and adds a columns H value to column F if the values are the same. Here is what I have done:

Private Sub CommandButton1_Click()

ActiveSheet.Range("A1:E100").RemoveDuplicates Columns:=Array(1, 2, 3),     Header:=xlYes

For Each ordernmb In Range("A1:A100")
    If ordernmb = "1" Then
        ordernmb.Offset(0, 5).Value = "work"

    ElseIf ordernmb = "2" Then
        ordernmb.Offset(0, 5).Value = "school"

    End If

    Next ordernmb

End Sub

In the real excel, I have over 10 000 rows, 15 columns so this code was way to slow for that. What should I do?

How to&Answers:

As per my comments you can speed up your process by going through memory instead of Range objects (accessing cells one after the other is slow).

So with this specific sample data that looks like:

enter image description here

Example code could look like:

Sub Test()

Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim lr As Long, x As Long
Dim arr As Variant

With Sheet1 'Change according to your sheets CodeName

    'Populate dictionary from column G:H
    lr = .Cells(.Rows.Count, 7).End(xlUp).Row
    arr = .Range("G1:H" & lr)
    For x = LBound(arr) To UBound(arr)
        dict.Add arr(x, 1), arr(x, 2)
    Next x

    'Delete duplicates in columns A:E
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("A1:E" & lr).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlNo

    'Go through remaining values to get values for column F
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("A1:F" & lr)
    For x = LBound(arr) To UBound(arr)
        arr(x, 6) = dict(arr(x, 1))
    Next x

    'Populate column F
    .Range("A1:F" & lr) = arr

End With

End Sub

Would result in:

enter image description here