PDA

View Full Version : Add and Sort



NWE
05-30-2019, 10:19 PM
Hello,

I have two list of number on two separate sheets. I am trying to figure out how to compare the two lists, add the numbers that are on list one that don't exist on list two to list two and finally sort them so they match. I have attached a workbook and this what I have so far:



Sub Addsort()
Dim rngCell As Range
Dim lastrow As Long


For Each rngCell In Worksheets("Sheet 1").Range("A2:A10001")
If WorksheetFunction.CountIf(Worksheets("Sheet 2").Range("A2:A100001"), rngCell) = 0 Then
lastrow = Worksheets("Sheet 2").Cells(Rows.Count, "A").End(xlUp).Row
Worksheets("Sheet 2").Range("A2:A" & lastrow).Value = rngCell
End If
Next rngCell
Sheets("Sheet 2").Range("A2", Range("A2").End(xlDown)).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes
End Sub



Thanks.

大灰狼1976
05-30-2019, 11:08 PM
Hi NWE!

Sub test()
Dim arr, i&, d As Object
Set d = CreateObject("scripting.dictionary")
arr = Sheets(1).[a1].CurrentRegion
For i = 2 To UBound(arr)
d(arr(i, 1)) = ""
Next i
arr = Sheets(2).[a1].CurrentRegion
For i = 2 To UBound(arr)
If d.exists(arr(i, 1)) Then d.Remove arr(i, 1)
Next i
With Sheets(3)
.[a2].Resize(d.Count) = Application.Transpose(d.keys)
.[a1].CurrentRegion.Sort Key1:=.[a1], Order1:=xlAscending, Header:=xlYes
End With
End Sub

NWE
05-30-2019, 11:36 PM
Hi!

It is saying that sheets 3 is out of range. I want to add the list that doesn't exist two the list on sheet 2.

大灰狼1976
05-30-2019, 11:52 PM
So export it to column C of sheet2, something like below:

Sub test()
Dim arr, i&, d As Object
Set d = CreateObject("scripting.dictionary")
arr = Sheets(1).[a1].CurrentRegion
For i = 2 To UBound(arr)
d(arr(i, 1)) = ""
Next i
arr = Sheets(2).[a1].CurrentRegion
For i = 2 To UBound(arr)
If d.exists(arr(i, 1)) Then d.Remove arr(i, 1)
Next i
With Sheets(2)
.[c1] = "Line"
.[c2].Resize(d.Count) = Application.Transpose(d.keys)
.[c1].CurrentRegion.Sort Key1:=.[c1], Order1:=xlAscending, Header:=xlYes
End With
End Sub

NWE
06-03-2019, 01:51 PM
Sorry this got sent to my spam mail. I have been playing around with simply adding it to column A of sheet 2 (the ones that don't exist) and then resorting it. Using your code:


ith Sheets(2)
.[A1] = "Line"
.[A1].Resize(d.Count) = Application.Transpose(d.keys)
.[A1].CurrentRegion.Sort Key1:=.[A1], Order1:=xlAscending, Header:=xlYes
End With


End Sub


Correct?

Paul_Hossler
06-03-2019, 02:25 PM
Hello,

I have two list of number on two separate sheets. I am trying to figure out how to compare the two lists, add the numbers that are on list one that don't exist on list two to list two and finally sort them so they match. I have attached a workbook and this what I have so far:


If a number is on List1 but not on List2, then add it to List2

What if there's a number on List2 that is not on List1?

No matter how you sort, they'll never match

NWE
06-03-2019, 02:39 PM
I just need everything on list one to be on list two. If it is on list two, then it wouldn't affect list one as I wrote another function to deal with that. Would breaking it up into two subs help. For example the sort sub comes after the list adding?

Paul_Hossler
06-03-2019, 04:37 PM
I'd just do something simple like this




Option Explicit


Sub Addsort()
Dim rList1 As Range, rList2 As Range, r As Range, r1 As Range
Dim ary1() As Variant, ary2() As Variant
Dim i As Long, n As Long

With Worksheets("Sheet 1")
Set rList1 = Range(.Cells(1, 1), .Cells(1, 1).End(xlDown))
End With
ary1 = Application.WorksheetFunction.Transpose(rList1)

With Worksheets("Sheet 2")
Set rList2 = Range(.Cells(1, 1), .Cells(1, 1).End(xlDown))
End With
ary2 = Application.WorksheetFunction.Transpose(rList2)

For i = LBound(ary1) + 1 To UBound(ary1)
n = 0
On Error Resume Next
n = Application.WorksheetFunction.Match(ary1(i), ary2, 0)
On Error GoTo 0

If n = 0 Then
ReDim Preserve ary2(LBound(ary2) To UBound(ary2) + 1)
ary2(UBound(ary2)) = ary1(i)
End If
Next i


With Worksheets("Sheet 2")
.Cells(1, 1).Resize(UBound(ary2), 1).Value = Application.WorksheetFunction.Transpose(ary2)

Set r = Range(.Cells(1, 1), .Cells(1, 1).End(xlDown))
Set r1 = r.Cells(2, 1).Resize(r.Rows.Count - 1, r.Columns.Count)
With .Sort
.SortFields.Clear
.SortFields.Add Key:=r1, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange r
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With

End Sub

NWE
06-04-2019, 12:28 PM
Hi,

I am going to mix it up a bit. I am going to use the insert row method. Would the argument for the range be aryl(i) from the above? Or do we need to designate another variable. I tried inserting directly into "Insert" part of function



With Sheets("Sheet2").Range("A1:A10000")
lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
.Insert ary1(i) CopyOrigin:=xlFormatFromLeftOrAbove


Basically I am trying to not only get it to insert but to add rows as well during the insert and before the sort.