How to loop through a range of cells?

Question

I have values in this "Sample Analysis Data" sheet in the range B2:B10.

For each cell in the range, the code looks for that value in the sheet "Meta Data". It then copies the cells in that row and pastes it in "Sample Analysis Data" (to the right of the searched value). This works for the value in B2.

I can't get it to move on to B3 and then B4 and such. It loops though and does the same thing again for B2.

What do I need to do to get it to loop to from B2 through to B10?
Along with this, how do I get it to go from B2 to the last entry in the column (as each data set I work with could have a different number of rows of data,) not just to B10?

Sub GetMetaData()

    Worksheets("Sample Analysis Data").Activate
    Range("B2").Select

    Dim srch As Range, cell As Variant
    Set srch = Range("B2:B10")

    For Each cell In srch
        Sheets("Meta Data").Activate

        Cells.Find(What:=cell, LookIn:=xlValues, LookAt:= _
          xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
          , SearchFormat:=False).Activate

        ActiveSheet.Cells(ActiveCell.Row, 1).Select
        Range(ActiveCell, ActiveCell.End(xlToRight).End(xlToRight)).Select

        Application.CutCopyMode = False
        Selection.Copy

        Sheets("Sample Analysis Data").Activate

        ActiveCell.Offset(0, 7).Select
        ActiveSheet.Paste

    Next cell
End Sub

If you haven't read it already, give [this question](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) a read. It will help you solve your problem. — BigBen, Oct 31 '19 at 19:10

Emi · Answer 1 · 2019-11-01T15:13:44.477

0

Try this? Change the i=8 to however many cells you need to offset (you indicated B2:B10, which is 8)

Sub testcopy()

    Dim srch As Range, metarg As Range, rg As Range, pstrg As Range
    Dim i As Long
    Dim ws As Worksheet, ws2 As Worksheet

    Set ws = ThisWorkbook.Sheets("Sample Analysis Data")
    Set ws2 = ThisWorkbook.Sheets("Meta Data")

    Set metarg = ws2.Range("A1:A100") 'range that includes the key that you are searching in B2:B10

    Set srch = ws.Range("B1")  'i'm offsetting, so i'm going back one row
    For i = 1 To 8 'change 8 to how many cells to offset
        Set rg = metarg.Find(srch.Offset(i, 0).Value, LookIn:=xlValues, lookat:=xlWhole) 'find the value in meta sheet
        If Not rg Is Nothing Then
            Set pstrg = ws2.Range(rg, ws2.Cells(rg.Row, rg.End(xlToRight).Column))
            pstrg.Copy
            srch.Offset(i, 1).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End If
    Next i

    End Sub

edited Nov 01 '19 at 15:13

answered Oct 31 '19 at 21:04

Emi

23
3

Thanks for looking at this! So, this is looping, but not really doing anything. Perhaps I need to be more explicit in what needs to happen. Basically, I have data in ws and extra meta data in ws2 and need to combine them. So. the code first looks at B2 in ws and remembers that value. It then goes to ws2 and searches for that value....and copies everything in that row. It then goes back to ws and pastes that value next to the cell B2 (so, it needs to be offset by a few cells). It then goes on to B3 and does the same thing, so, looping though the other cells. – Greg Nov 01 '19 at 14:01
Sorry- that was super sloppy! I amended start range from B2 to B1 as you are offsetting with 1, and added the offset to paste range as well. – Emi Nov 01 '19 at 15:14

How to loop through a range of cells?

1 Answers1