Results 1 to 4 of 4

Thread: Help with some code
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Jan 2017
    Posts
    23
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Help with some code

    Hi Guys,

    I'm trying to rearrange some data and having trouble with getting it to correctly loop through a list.

    Basically I have data in columns 1-39 with no gaps. Column N contains names. I am trying to create something which takes the name on any given row (From N2 down) and searches for matches in all rows below given row. Each time it finds a match it copies all the data from each row and pastes it all on the same row which the original name came from. Then this would loop only the next cell so N3, take the name, find matched below paste all the the right etc.

    So i can get the code to do the procedure i want one time, on N2, but then cant get that to loop through all the names AND find all the below matched and paste them on the same row.

    At the moment it's looping through the N column (somehow) and pasting everything on the first row. I cant correctly make it offset the paste to BB3 etc. without getting an error.

    This is what i have:

    Code:
    
    
    Code:
    Sub finddata()
    
    Dim name As String
    Dim finalrow As Integer
    Dim startrow As Integer
    Dim i As Integer
    Dim offset As Integer
    
    
    Sheets("Sheet1").Range("BB2:CAA5000").ClearContents
    
    
    Range("BB2").Select
        ActiveCell.FormulaR1C1 = "0"
        Range("BC2").Select
        ActiveCell.FormulaR1C1 = "0"
        
    name = Sheets("Sheet1").Range("N2").Value                          'Needs to loop down the N column from N2
    
    
    startrow = Sheets("sheet1").Range("N2").Row                         'Needs to be the current row in the loop
    
    
    finalrow = Sheets("sheet1").Range("C100000").End(xlUp).Row
    
    
    Dim cell As Range
    
    
    For Each cell In ActiveSheet.Range("N2:N1000")
       
    For i = startrow To finalrow
    If Cells(i, 14) = name Then
        Range(Cells(i, 1), Cells(i, 39)).Copy
        Range("BB2").Select
        Selection.End(xlToRight).Select
        Selection.offset(0, 1).PasteSpecial xlPasteValues
        End If
    Next i
    
    
      Next cell
      
    End Sub



    It's a bit messy as the loop is sort of just stuck in there. Any help would be much appreciated.

    Thanks
    Dave
    Last edited by davio565; Jun 7th, 2019 at 08:36 PM. Reason: error

  2. #2
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    29,229
    Post Thanks / Like
    Mentioned
    483 Post(s)
    Tagged
    49 Thread(s)

    Default Re: Help with some code

    How about
    Code:
    Sub finddata()
    
    Dim name As String
    Dim finalrow As Integer
    Dim startrow As Integer
    Dim i As Integer
    
    
    Sheets("Sheet1").Range("BB2:CAA5000").ClearContents
    
    
    Range("BB2").Select
        ActiveCell.FormulaR1C1 = "0"
        Range("BC2").Select
        ActiveCell.FormulaR1C1 = "0"
        
    finalrow = Sheets("sheet1").Range("C100000").End(xlUp).Row
    
    
    Dim cell As Range
    
    
    For Each cell In ActiveSheet.Range("N2:N" & finalrow)
       
    For i = cell.Row + 1 To finalrow
    If Cells(i, 14) = cell.Value Then
        Range(Cells(i, 1), Cells(i, 39)).Copy
        Cells(cell.Row, Columns.Count).End(xlToLeft).Offset(,1).PasteSpecial xlPasteValues
        End If
    Next i
    
    
      Next cell
      
    End Sub
    Last edited by Fluff; Jun 8th, 2019 at 09:43 AM.
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  3. #3
    New Member
    Join Date
    Jan 2017
    Posts
    23
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Help with some code

    Hi Fluff,

    Very late on but just wanted to say thanks for this code you did ages ago. Just realised I never thanked you.

    Worked really well and I managed to modify it a few times for my needs.

    Thanks
    Dave

  4. #4
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    29,229
    Post Thanks / Like
    Mentioned
    483 Post(s)
    Tagged
    49 Thread(s)

    Default Re: Help with some code

    Glad to hear you've managed to modify to suit & thanks for the feedback
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •