Excel VBA Insert Row Values From Sheet-to-Sheet

Experts,
Attached is a file with two worksheets, All Data and Data to Insert. What is needed, is the correct code to take each value in Data to Insert - Column A,  and inset the row, between the two closest values, within the All Data worksheet.
Example:
Data to Insert worksheet
Row 1 Col A has a value of Z9204-010

All Data worksheet has values in rows 44-46 of:
44  Z9203-011     ...rest of row
45  Z9204-011     ...rest of row
46  Z9205-010     ...rest of row

The Col A Row 1.EntireRow will be inserted into All Data, at Row 45 so that the new sequence would be:
44  Z9203-011     ...rest of row
45  Z9204-010     ...rest of row
46  Z9204-011     ...rest of row
47  Z9205-010     ...rest of row

The information in Data to Insert worksheet should not be deleted.

Cook09
Labels-Part-2.xlsx
Cook09Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Roy CoxGroup Finance ManagerCommented:
Do you want to copy all the data from one sheet to the next?

If so maybe copy the daat then sort the master sheet.
0
Patrick MatthewsCommented:
Roy's suggestion is by far the easiest if you don't care about avoiding duplicates.  Since your example 'All Data' worksheet already includes a few (three) duplicate rows, this may not be a problem.

OTOH, if you only want to insert the row if it does not already exist, try this:

1) Without VBA:

Put this formula in 'Data to Insert'!F1, and copy down as needed:
=COUNTIFS('All Data'!$A$2:$A$276,A1,'All Data'!$B$2:$B$276,B1,'All Data'!$C$2:$C$276,C1,'All Data'!$D$2:$D$276,D1,'All Data'!$E$2:$E$276,E1)

Sort 'Data to Insert' on Col F to isolate the rows where the value is zero.

Copy A:E from those rows and paste to the bottom of 'All Data', then sort 'All Data'

2) With VBA:

Sub InsertData()
    
    Dim InsertWs As Worksheet, AllWs As Worksheet
    Dim LastRInsert As Long, LastRAll As Long
    Dim arr As Variant
    Dim DestR As Long
    Dim Counter As Long
    Dim DestArr(1 To 1, 1 To 5) As Variant
    
    Set InsertWs = ThisWorkbook.Worksheets("Data to Insert")
    Set AllWs = ThisWorkbook.Worksheets("All Data")
    
    With InsertWs
        LastRInsert = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("f1").Resize(LastRInsert, 1).Formula = "=COUNTIFS('All Data'!$A$2:$A$276,A1," & _
            "'All Data'!$B$2:$B$276,B1,'All Data'!$C$2:$C$276,C1,'All Data'!$D$2:$D$276,D1," & _
            "'All Data'!$E$2:$E$276,E1)"
        .Range("a1").Sort Key1:=.Range("f1"), Order1:=xlAscending, Header:=xlNo
        arr = .Range("a1").Resize(LastRInsert, 6).Value
        .Columns(6).Delete
    End With
    
    With AllWs
        LastRAll = .Cells(.Rows.Count, 1).End(xlUp).Row
        DestR = LastRAll
        For Counter = 1 To LastRInsert
            If arr(Counter, 6) = 0 Then
                DestR = DestR + 1
                DestArr(1, 1) = arr(Counter, 1)
                DestArr(1, 2) = arr(Counter, 2)
                DestArr(1, 3) = arr(Counter, 3)
                DestArr(1, 4) = arr(Counter, 4)
                DestArr(1, 5) = arr(Counter, 5)
                .Cells(DestR, 1).Resize(1, 5).Value = DestArr
            Else
                Exit For
            End If
        Next
        With .Sort
            With .SortFields
                .Clear
                .Add Key:=Range("A2:A" & DestR), SortOn:=xlSortOnValues, Order:=xlAscending, _
                    DataOption:=xlSortNormal
                .Add Key:=Range("B2:B" & DestR), SortOn:=xlSortOnValues, Order:=xlAscending, _
                    DataOption:=xlSortNormal
                .Add Key:=Range("C2:C" & DestR), SortOn:=xlSortOnValues, Order:=xlAscending, _
                    DataOption:=xlSortNormal
                .Add Key:=Range("D2:D" & DestR), SortOn:=xlSortOnValues, Order:=xlAscending, _
                    DataOption:=xlSortNormal
                .Add Key:=Range("E2:E" & DestR), SortOn:=xlSortOnValues, Order:=xlAscending, _
                    DataOption:=xlSortNormal
            End With
            .SetRange Range("A1:E" & DestR)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
    
    MsgBox "Done"
    
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Roy CoxGroup Finance ManagerCommented:
The duplicates would be simple to remove using the remove duplicates feature in the data tab. Sample VBA code:

ActiveSheet.Range("$A$1:$A$3").RemoveDuplicates Columns:=1, Header:=xlNo

Open in new window

0
CompTIA Security+

Learn the essential functions of CompTIA Security+, which establishes the core knowledge required of any cybersecurity role and leads professionals into intermediate-level cybersecurity jobs.

Cook09Author Commented:
Patrick,
When this was transferred over to a second spreadsheet that has 1912 rows, I was able to get it to run through all the rows, but, it inserted the duplicate values, as duplicates, even though both values in Column A were the same.

I like the concept where it copies the additional information that is in a similar worksheet as ALL Data (ALL MAC), but has more columns that is not in Insert Data ("Worksheet"). As it moves the rows over.... it still keeps both the first and second full dataset (A-H in ALL MAC) of the original and duplicate value in Column A.  

Also, If I wanted to have a header, would I just change the.....Header = xlYes?
This is my modified version of yours...
Sub InsertData()
    
    Dim InsertWs As Worksheet, AllWs As Worksheet
    Dim LastRInsert As Long, LastRAll As Long
    Dim arr As Variant
    Dim DestR As Long
    Dim Counter As Long
    Dim DestArr(1 To 1, 1 To 5) As Variant
    
    Set InsertWs = ThisWorkbook.Worksheets("Worksheet")
    Set AllWs = ThisWorkbook.Worksheets("ALL MAC")
    
    With InsertWs
        LastRInsert = .Cells(.Rows.Count, 1).End(xlUp).Row
         .Range("f1").Resize(LastRInsert, 1).Formula = "=COUNTIFS('ALL MAC'!$A$2:$A$1912,A1," & _
            "'ALL MAC'!$B$2:$B$1912,B1,'ALL MAC'!$C$2:$C$1912,C1,'ALL MAC'!$D$2:$D$1912,D1," & _
            "'ALL MAC'!$E$2:$E$1912,E1)"
        .Range("a1").Sort Key1:=.Range("f1"), Order1:=xlAscending, Header:=xlNo
        arr = .Range("a1").Resize(LastRInsert, 6).Value
        .Columns(6).Delete
    End With
    
    With AllWs
        LastRAll = .Cells(.Rows.Count, 1).End(xlUp).Row
        DestR = LastRAll
        For Counter = 1 To LastRInsert
            If arr(Counter, 6) = 0 Then
                DestR = DestR + 1
                DestArr(1, 1) = arr(Counter, 1)
                DestArr(1, 2) = arr(Counter, 2)
                DestArr(1, 3) = arr(Counter, 3)
                DestArr(1, 4) = arr(Counter, 4)
                DestArr(1, 5) = arr(Counter, 5)
                .Cells(DestR, 1).Resize(1, 5).Value = DestArr
            Else
                Exit For
            End If
        Next
        With .Sort
            With .SortFields
                .Clear
                .Add Key:=Range("A2:A" & DestR), SortOn:=xlSortOnValues, Order:=xlAscending, _
                    DataOption:=xlSortNormal
                .Add Key:=Range("B2:B" & DestR), SortOn:=xlSortOnValues, Order:=xlAscending, _
                    DataOption:=xlSortNormal
                .Add Key:=Range("C2:C" & DestR), SortOn:=xlSortOnValues, Order:=xlAscending, _
                    DataOption:=xlSortNormal
                .Add Key:=Range("D2:D" & DestR), SortOn:=xlSortOnValues, Order:=xlAscending, _
                    DataOption:=xlSortNormal
                .Add Key:=Range("E2:E" & DestR), SortOn:=xlSortOnValues, Order:=xlAscending, _
                    DataOption:=xlSortNormal
            End With
            .SetRange Range("A1:E" & DestR)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
    
    MsgBox "Done"
    
End Sub

Open in new window

Cook09
0
Cook09Author Commented:
Roy,
Which of the two duplicates will be removed?  When I tried it, by the Header Name in Column A and Column B, it did select the correct one (I bolded the new ones for verification). Does it know which was inserted or placed in there last, then removes the first?  If I added three or four Header Items, then it would seem to take the complex and make it simple...am I understanding this correctly?

Cook09
0
Roy CoxGroup Finance ManagerCommented:
I think it keeps the first matching item then deletes the rest. You can also use AdvancedFilter and filter in place for unique items
0
Cook09Author Commented:
Experts,
Is there a way to Delete the Non-Bolded Item within the Duplicate pair found during a Manual Insert at Bottom, Bolded then performing an ascending sort. The bolded items pasted at the end or the original dataset are now intermingled and a Duplicate Pair is observed for those that are not unique.

The Manual Method recommend by Roy does have some merit.  It's easy to copy the new data, bold it, and then filter in ascending order.  The newly inserted data, is now very visible, especially with Conditional Formatting turned on.  

In both cases of filtering, there are still two items left, the original non-bolded item and the bolded one that was just pasted. However, if there are a more than 100 items that are not unique, then one has to manually delete each old (original) row within the duplicate pair.

Is there a way to delete the non-bolded item, within the Duplicate Pair?

Cook09
0
Cook09Author Commented:
Still needed a way to delete those that due show up as duplicates, as per the next to last comment.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.