Copy a cell and give paste for each name in dataset

[Hyflex]

I'm not too sure how to explain this but my example document shows how I need a macro to work.

Search for "Name", offset 0,-1 and copy, then offset 6,1 from searched word and paste and drag location down for however many names are in the dataset

Thanks in advance.

[tigeravatar]

Hyflex,

Your data is in column A, so when you say offset(0,-1), that's trying to get 1 cell to the left of column A, which doesn't exist. Do you mean go one cell down? (which would be offset(1,0)

[tigeravatar]

Oooh, i think i see what you want now. In column A, search for text "Name". Then go to the cell above it (one row up), which would be .Offset(-1,0). Ok, I get it now, will have a macro in a sec

[tigeravatar]

Give this a try:

Sub tgr()
    
    Dim rngName As Range: Set rngName = Columns("A").Find("Name")
    If rngName Is Nothing Then
        MsgBox "No cells in column A that contain ""Name"""
        Exit Sub
    End If
    Dim rngPrior As Range: Set rngPrior = rngName
    
    While Not rngName Is Nothing
        If rngName.Row < rngPrior.Row Then Exit Sub
        rngName.Offset(-1, 0).Copy rngName.Offset(1, 6).Resize(rngName.CurrentRegion.Rows.Count - 2)
        Set rngPrior = rngName
        Set rngName = Columns("A").Find("Name", rngName)
    Wend
    
End Sub

[Hyflex]

Give this a try:

Sub tgr()
    
    Dim rngName As Range: Set rngName = Columns("A").Find("Name")
    If rngName Is Nothing Then
        MsgBox "No cells in column A that contain ""Name"""
        Exit Sub
    End If
    Dim rngPrior As Range: Set rngPrior = rngName
    
    While Not rngName Is Nothing
        If rngName.Row < rngPrior.Row Then Exit Sub
        rngName.Offset(-1, 0).Copy rngName.Offset(1, 6).Resize(rngName.CurrentRegion.Rows.Count - 2)
        Set rngPrior = rngName
        Set rngName = Columns("A").Find("Name", rngName)
    Wend
    
End Sub

I tried to make it do exact matchs for the word "Name" but it doesnt work, I really struggle to put the LookAt:=xlWhole part in...

[tigeravatar]

Hyflex,

Here's the code with the LookAt:=xlWhole property

Sub tgr()
    
    Dim rngName As Range: Set rngName = Columns("A").Find(What:="Name", LookAt:=xlWhole)
    If rngName Is Nothing Then
        MsgBox "No cells in column A that contain ""Name"""
        Exit Sub
    End If
    Dim rngPrior As Range: Set rngPrior = rngName
    
    While Not rngName Is Nothing
        If rngName.Row < rngPrior.Row Then Exit Sub
        rngName.Offset(-1, 0).Copy rngName.Offset(1, 6).Resize(rngName.CurrentRegion.Rows.Count - 2)
        Set rngPrior = rngName
        Set rngName = Columns("A").Find(What:="Name", After:=rngName, LookAt:=xlWhole)
    Wend
    
End Sub