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?
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:
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: