Inserting selected rows in another sheet

[JohnGiacon]

Hi,

I want to transfer data from one sheet (Sheet2) to another (Sheet1)

Sheet1 has dictionary headwords, with a unique ID number .

Sheet2 has a number [perhaps zero] of rows, with headword ID.

I have managed to select and copy the information in sheet2 for an ID – for 2 here.
I want to insert those rows under the row with ID 2 in sheet 1, i.e. under row 3.

The code I have for the selecting and copying the rows is not elegant, so an elegant way of doing the whole thing would be a bonus.

Sheet 1 has about 4,500 rows, sheet 2 about 20,000, so a way of looping and checking every x loops would be great.

Thanks, John

 

[Peter_SSs]

Welcome to the MrExcel board!

It is a little unclear

• If you want to copy all ID sections to Sheet 1 or juts a selected one. I have gone for "just a selected one" based on your thread title.
• Whether the row selection is manual or should be part of the code. I have assumed manual.
• If you also want to remove the selected rows from Sheet2. I have assumed not.

I have also assumed that you will have selected rows for just a single ID number (2 in your image).

Try this with a copy of your workbook.

If this is not what you want, please provide further details.

Sub MoveSelectedRows()
  Dim rFound As Range
  
  With Selection
    If ActiveSheet.Name = "Sheet2" And .Address = .EntireRow.Address Then
      Set rFound = Sheets("Sheet1").Columns(1).Find(what:=.Cells(1, 1).Value, LookAt:=xlWhole, SearchDirection:=xlPrevious)
      If rFound Is Nothing Then
        MsgBox "Unable to find ID " & .Cells(1, 1).Value & " in Sheet1"
      Else
        .Copy
        rFound.Offset(1).Insert
        Application.CutCopyMode = False
      End If
    End If
  End With
End Sub

 

[JohnGiacon]

Hi Peter.

Thanks a lot. Works beautifully.

I want to copy all ID sections on sheet 2, i.e. about 20,000 of them.
I have a messy code to do row selection. Would be great to have neat code to do that.
I've been using
Dim ID As long and manually putting in the ID just while developing the code.
Ideally the complete code would loop, something like:
For ID = 1 to end, with the loop stopping every 10 or so to check that it is all good.
I don't want to remove the selected rows from Sheet2.

Hope that is clear.
John

 

[Peter_SSs]

with the loop stopping every 10 or so to check that it is all good.

I have not tried to build anything like that in. I'd suggest testing/checking on data that gradually increases in size. Then when/if confident, run it on the main data (but still use a copy to start with )

Sub MoveRowBlocks()
  Dim a As Variant
  Dim rFound As Range
  Dim sNotFound As String
  Dim fr As Long, rws As Long, i As Long, k As Long
  
  Application.ScreenUpdating = False
  With Sheets("Sheet2")
    a = .Range("A1", .Range("B" & Rows.Count).End(xlUp).Offset(1)).Value
    For i = 2 To UBound(a)
      If a(i, 1) = a(i - 1, 1) Then
        rws = rws + 1
      Else
        k = k + 1
        a(k, 1) = a(i - 1, 1): a(k, 2) = rws
        rws = 1
      End If
    Next i
    fr = 2
    For i = 2 To k
      Set rFound = Sheets("Sheet1").Columns(1).Find(what:=a(i, 1), LookAt:=xlWhole, SearchDirection:=xlPrevious)
      If rFound Is Nothing Then
        sNotFound = sNotFound & ", " & a(i, 1)
      Else
        .Rows(fr).Resize(a(i, 2)).Copy
        rFound.Offset(1).Insert
      End If
      fr = fr + a(i, 2)
    Next i
  End With
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
  MsgBox "Done." & IIf(Len(sNotFound) = 0, "", " The following IDs from Sheet 2 were not found on Sheet1: " & vbLf & Mid(sNotFound, 3))
End Sub

 

[JohnGiacon]

Hi Peter, Works beautifully, Thanks. My 25 hours working on Macros got me nowhere near this. One issue – I created a blank column B in Sheet2 for formatting reasons in the final product. It then did not work. When I entered something in column B, say in B23, it worked till there then returned the message "Done". Would you like me to try to install XL2BB Add-in to send you mini-sheets? John

 

[Peter_SSs]

Would you like me to try to install XL2BB Add-in ...

It would be a good idea to do that in case you have future questions but for this issue I think that we only need to change one line as follows

Sub MoveRowBlocks_v2()
  Dim a As Variant
  Dim rFound As Range
  Dim sNotFound As String
  Dim fr As Long, rws As Long, i As Long, k As Long
  
  Application.ScreenUpdating = False
  With Sheets("Sheet2")
    a = .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row + 1).Value '<- *** This line changed ***
    For i = 2 To UBound(a)
      If a(i, 1) = a(i - 1, 1) Then
        rws = rws + 1
      Else
        k = k + 1
        a(k, 1) = a(i - 1, 1): a(k, 2) = rws
        rws = 1
      End If
    Next i
    fr = 2
    For i = 2 To k
      Set rFound = Sheets("Sheet1").Columns(1).Find(what:=a(i, 1), LookAt:=xlWhole, SearchDirection:=xlPrevious)
      If rFound Is Nothing Then
        sNotFound = sNotFound & ", " & a(i, 1)
      Else
        .Rows(fr).Resize(a(i, 2)).Copy
        rFound.Offset(1).Insert
      End If
      fr = fr + a(i, 2)
    Next i
  End With
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
  MsgBox "Done." & IIf(Len(sNotFound) = 0, "", " The following IDs from Sheet 2 were not found on Sheet1: " & vbLf & Mid(sNotFound, 3))
End Sub

 

[JohnGiacon]

Thanks again Peter. Works great. I'm hoping for a tweak. Sheet 1 starts off with the dictionary headwords. I will put various things in sheet 2 that need to be moved under the headwords in sheet 1; e.g. a) the source of the information b) example sentences c) comments.
After adding one lot of material there may be multiple IDs in column A of Sheet1, as in the following, after adding 'source' information.The first line is what was originally in sheet 1.

3276​	-baa_YR
3276​	source
3276​	source
3276​	source

I would like the next lot of information rows to go after the first instance of the ID [3276].
I owe you a bottle, or box, of wine next time you are in Canberra.

 

[Peter_SSs]

I don't fully understand. What about smallish 'before' and 'after' mini sheets of dummy sample data with XL2BB & explain again with specific reference to that sample data?

 

[JohnGiacon]

Hi Peter,
Sheet1 starts of just having the Dictionary headwords. Im looking a -baa_YR, ID 3276

MacroPlayPlay.xlsm
	A	B	C
9	1645	baa2_YY	noun
10	96	-baa_GR	suffix
11	3276	-baa_YR	suffix
12	3277	-baa_YY	suffix
13	1154	baabi-li_YY	verb-intransitive
14	3175	baabi-li_GR	verb-intransitive
HeadWWork

After adding the source information [which is in Sheet2], it is followed by 3 rows of source information, which include the ID number 3276 in columnA.

MacroPlayPlay.xlsm
	A	B	C
13	3276	-baa_YR	suffix
14	3276	source	-baa
15	3276	source	-baa
16	3276	source	-baa
17	3277	-baa_YY	suffix
Sheet1

Having added all the source information to all the headwords, I now need to add other information such as 'example sentences', by replacing the 'source' information in sheet 2 with the 'example sentences' information.

If I run the sub again with multiple instances of the one ID in Sheet1, e.g. 3276, I don't know what will happen; guess I could try. I was asking if the code could be modified so that each time the sub is run the information is inserted after the headword, i.e. after the first instance of an ID.
There are around 6 different lots of information to add in, I'm thinking by running the code 6 times with different information in Sheet2 each time.

Let me know if this is not clear.

Thanks, John

 

[Peter_SSs]

Let me know if this is not clear.

Sorry, I am even less clear now.

You start off telling me Sheet1 starts off having the "Dictionary headwords"

• I have no idea what that term means
• Immediately under that statement you show a sheet called "HeadWWork", not "Sheet1"
• I don't really know what you mean by "starts off" since both sheets shown start well below row 1

After adding the source information [which is in Sheet2]

• There is no sheet shown called "Sheet2"
• Is the "adding" mentioned here something you have done or something the code I have provided has done?

If I run the sub again with multiple instances of the one ID in Sheet1, e.g. 3276, I don't know what will happen; guess I could try.

Yes, that is very easy to find out. Just use a copy of your workbook to run as many times as you want.

I was asking if the code could be modified so that each time the sub is run the information is inserted after the headword, i.e. after the first instance of an ID.

OK, finally something that I understand.
So, forgetting everything else it is again a very small change to the previous code to do that. Give it a go.

Sub MoveRowBlocks_v3()
  Dim a As Variant
  Dim rFound As Range
  Dim sNotFound As String
  Dim fr As Long, rws As Long, i As Long, k As Long
 
  Application.ScreenUpdating = False
  With Sheets("Sheet2")
    a = .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row + 1).Value
    For i = 2 To UBound(a)
      If a(i, 1) = a(i - 1, 1) Then
        rws = rws + 1
      Else
        k = k + 1
        a(k, 1) = a(i - 1, 1): a(k, 2) = rws
        rws = 1
      End If
    Next i
    fr = 2
    For i = 2 To k
      Set rFound = Sheets("Sheet1").Columns(1).Find(what:=a(i, 1), LookAt:=xlWhole, SearchDirection:=xlNext)
      If rFound Is Nothing Then
        sNotFound = sNotFound & ", " & a(i, 1)
      Else
        .Rows(fr).Resize(a(i, 2)).Copy
        rFound.Offset(1).Insert
      End If
      fr = fr + a(i, 2)
    Next i
  End With
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
  MsgBox "Done." & IIf(Len(sNotFound) = 0, "", " The following IDs from Sheet 2 were not found on Sheet1: " & vbLf & Mid(sNotFound, 3))
End Sub