Loop to get loction then start next loop-CodePudding

Amended.

Loop01, loop through column B to find the value "x", then use that value position as the starting point for the next loop. Loop02, loop through column B. If the value matches, put the "data" value in row 2, column D for D, E for E... If Loop02 finds the value "x", then start Loop02 again on a new row.

I have attached an image.

See Image

Sub Test()
Dim N As Long, i As Long, i2 As Long, j As Long
N = Cells(Rows.Count, "A").End(xlUp).Row
j = 2
LD = Sheet1.Range("D1").Value
LE = Sheet1.Range("E1").Value
LF = Sheet1.Range("F1").Value
LG = Sheet1.Range("G1").Value
LH = Sheet1.Range("H1").Value
LI = Sheet1.Range("I1").Value
LJ = Sheet1.Range("J1").Value

For i = 2 To N
    If Cells(i, "B").Value = "x" Then
    i = i   1
        For i2 = 2 To N
            If Cells(i, "B").Value = "x" Then
                i = i - 1
                j = j   1
                Exit For
            End If
            If Cells(i, "B").Value = LD Then
                Cells(j, "D").Value = Cells(i, "A").Value
            End If
            If Cells(i, "B").Value = LE Then
                Cells(j, "E").Value = Cells(i, "A").Value
            End If
            If Cells(i, "B").Value = LF Then
                Cells(j, "F").Value = Cells(i, "A").Value
            End If
            If Cells(i, "B").Value = LG Then
                Cells(j, "G").Value = Cells(i, "A").Value
            End If
            If Cells(i, "B").Value = LH Then
                Cells(j, "H").Value = Cells(i, "A").Value
            End If
            If Cells(i, "B").Value = LI Then
                Cells(j, "I").Value = Cells(i, "A").Value
            End If
            If Cells(i, "B").Value = LJ Then
                Cells(j, "J").Value = Cells(i, "A").Value
            End If
            i = i   1
        Next i2
    End If
Next i

End Sub

CodePudding user response：

If I understand you correctly, maybe the sub below can get help you started.

Sub test()
Dim hdr As Range: Dim c As Range
Dim vHdr As Range: Dim ofst As Long: Dim rw As Long

Set hdr = Range("D1:J1")
rw = Range("B" & Rows.Count).End(xlUp).Row
ofst = 0
Set c = Columns(2).Find("x", lookat:=xlWhole)

If Not c Is Nothing Then
Set vHdr = c.Offset(1, 0)
    Do
    ofst = ofst   1
        Do
        If vHdr <> "" Then _
            hdr.Find(vHdr.Value).Offset(ofst, 0).Value = _
                                    vHdr.Offset(0, -1).Value
        Set vHdr = vHdr.Offset(1, 0)
        Loop Until vHdr.Value = "x"
    Set vHdr = vHdr.Offset(1, 0)
    Loop Until vHdr.Row >= rw
End If

End Sub

It create the header range (where the result will be) into hdr variable.
Get the last row with value in column B into rw variable.
Make ofst variable value with zero to use for the offset value.
Find the first occurence of "x" in column B as c variable and use c.offset(1,0) as vHdr variable.

The first loop is to have the next "x", and to add the ofst value 1
The second loop check if the vHdr value is not blank then it get the cell in hdr via find method where the value to find is the vHdr value.

After it get the cell in hdr which has the vHdr value, it use the found cell offset with ofst value to write the value in vHdr.offset(0,-1).