• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 455
  • Last Modified:

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
0
Cook09
Asked:
Cook09
  • 4
  • 3
4 Solutions
 
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
 
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
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: Microsoft Office 2010

This course will introduce you to the interfaces and features of Microsoft Office 2010 Word, Excel, PowerPoint, Outlook, and Access. You will learn about the features that are shared between all products in the Office suite, as well as the new features that are product specific.

  • 4
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now