[RESOLVED] Loop problem

Hello experts
I need to the following algorithm:

List of parts some prefixed ND/SD and others not prefixed ND/SD. For only 1 of each part (the same part can occur muultiple times sheet 1 "start with") i need to create 4 levels for parts not prefixed ND/SD and 2 levels for parts prefixed ND/SD for a standard partern depending on the starting.

Please see the start with and what I need to create (end with) programmatically. Please see the code so far for the small program and attached spreadsheet - please view the start with (data we need to manipulate) and end with sheet (what it needs to look like). I don't have anyything on levels within the code but this needs to be included.

VB Code:

Sub fullstructure()
Dim i As Long
Dim usedrange As Long
Dim rngdata As Range
Dim counter As Long
 
With Worksheets(1)
usedrange = .usedrange.Rows.Count
Set rngdata = .Range(.Cells(1, 1), .Cells(usedrange, 1))
End With
 
counter = 1
With rngdata
For i = 1 To .Rows.Count
If .Cells(i, 1) <> Cells(i + 1, 1) Then
'If Left(i, 2) <> "ND" Or _
'Left(i, 2) <> "SD" Then
Worksheets(2).Cells(counter, 1) = "CN-" & Cells(i, 1)
'Worksheets(2).Cells(counter + 1, 1) = "KIT-CN-" & Cells(i, 1)
'Worksheets(2).Cells(counter + 2, 1) = "IK-" & Cells(i, 1)
'Worksheets(2).Cells(counter + 3, 1) = "EBS-" & Cells(i, 1)
counter = counter + 1
'Else
'Worksheets(2).Cells(counter, 1) = "CN-" & Cells(i, 1)
'Worksheets(2).Cells(counter + 1, 1) = Cells(i, 1)
'counter = counter + 1
'End If
End If
Next i
End With
 
finish:
End Sub

Borris.

VB Code:

Sub fullstructure()
Dim i As Long
Dim usedrange As Long
Dim rngdata As Range
Dim counter As Long, thiscell As String
 
With Worksheets(1)
usedrange = .usedrange.Rows.Count
Set rngdata = .Range(.Cells(1, 1), .Cells(usedrange, 1))
End With
 
counter = 2
Worksheets(1).Activate
With rngdata
    For i = 1 To .Rows.Count
        If .Cells(i, 1) <> .Cells(i + 1, 1) Then
            thiscell = .Cells(i, 1)
            If Left(thiscell, 2) = "ND" Or Left(thiscell, 2) = "SD" Then
                
                 Worksheets(2).Cells(counter, 2) = "CN-" & Cells(i, 1)
                 Worksheets(2).Cells(counter, 1) = 1
                Worksheets(2).Cells(counter + 1, 2) = Cells(i, 1)
                Worksheets(2).Cells(counter + 1, 1) = 2
                counter = counter + 2
               
                Else
                Worksheets(2).Cells(counter, 2) = "CN-" & Cells(i, 1)
                Worksheets(2).Cells(counter, 1) = 1
                Worksheets(2).Cells(counter + 1, 2) = "KIT-CN-" & Cells(i, 1)
                Worksheets(2).Cells(counter + 1, 1) = 2
                Worksheets(2).Cells(counter + 2, 2) = "IK-" & Cells(i, 1)
                Worksheets(2).Cells(counter + 2, 1) = 3
                Worksheets(2).Cells(counter + 3, 2) = "EBS-" & Cells(i, 1)
                Worksheets(2).Cells(counter + 3, 1) = 4
                counter = counter + 4
            End If
        End If
'        counter = counter + 1
    Next i
End With
 
finish:
End Sub

i have made a few changes to your code, i think this is what you are asking for

pete

Thanks pete , your a legend on excel visual basic!