Loop within a loop vba

[Cladcore]

Capture.jpg

This is my data

For every UO1 theres S27 directly below it there can be multiple S27s for 1 UO1

and they allways relate to the Closest UO1 above it

what i need to happen is for every s27 row
the related UO1 row gets duplucated and the s27 moved accross

EXAMPLE:

UO1-01
S27-01
S27-02
U01 -02
S27-01
U01-03

After macro was run it would turn into this

Example

U01-01 S27-01
U01-01 S27-02
U01-02 S27-01
U01-03 S27-01

here is the code i have its close but doesnt work properly

Sub Test_cut()
Application.ScreenUpdating = False
  ActiveSheet.Range("A2").Select

    'Define the range variables
    Dim aCell As Range
    Dim bCell As Range
    Dim cCell As Range
    Dim dCell As Range
    Dim eCell As Range
    Dim fCell As Range
    Dim lrow As Long
    
  ' lrow = Cells(Rows.Count, 1).End(xlUp).Row
     
  '   MsgBox (lrow)
    Dim Trans_count As Long
    
 ' Trans_count = Application.WorksheetFunction.CountIf(Range("A:A"), "TRANS")
   Trans_count = Cells(Rows.Count, 1).End(xlUp).Row
  
  MsgBox (Trans_count)
  
    'Define the search criteria variables
    Dim Trans$
    Dim MTPNT$
    Dim ADDRS$
    Dim ASSET$
    Dim METER$
    Dim REGST$
    'The text for which to search
    Trans = "U02"
    MTPNT = "S72"
    ADDRS = "ADDRS"
    ASSET = "ASSET"
    METER = "METER"
    REGST = "REGST"
    
    'Now cut up the data for the correct number of TRANS records you found earlier
      i = 0
    Do Until i = Trans_count
    i = i + 1
    If ActiveCell.Value = "" Then
    Call Delete_row
    ElseIf ActiveCell.Value = ("U02") Then
    Call a_Trans
    ElseIf ActiveCell.Value = ("S72") Then
    Call a_cut
    ElseIf ActiveCell.Value = ("ADDRS") Then
    Call B_cut
    ElseIf ActiveCell.Value = ("ASSET") Then
    Call C_cut
    ElseIf ActiveCell.Value = ("METER") Then
    Call D_cut
    ElseIf ActiveCell.Value = ("REGST") Then
    Call E_cut
    ElseIf ActiveCell.Value = ("HEADR") Then
    Call H_Skip
    ElseIf ActiveCell.Value = ("TRAIL") Then
    Call T_Skip
    End If
     Loop
    
    Application.ScreenUpdating = True
 MsgBox ("done!")
        End Sub

Sub a_Trans()
ActiveCell.Offset(1, 0).Select
End Sub

Sub a_cut()
ActiveCell.Offset(-1, 0).Range(Cells(1, 16), (Cells(1, 30))).Value = ActiveCell.Range(Cells(1, 1), (Cells(1, 15))).Value
                                 ActiveCell.EntireRow.Select
                                 Selection.Delete Shift:=xlUp
End Sub

Sub B_cut()
ActiveCell.Offset(-1, 0).Range(Cells(1, 31), (Cells(1, 45))).Value = ActiveCell.Range(Cells(1, 1), (Cells(1, 15))).Value
                                 ActiveCell.EntireRow.Select
                                 Selection.Delete Shift:=xlUp
End Sub

Sub C_cut()
ActiveCell.Offset(-1, 0).Range(Cells(1, 46), (Cells(1, 60))).Value = ActiveCell.Range(Cells(1, 1), (Cells(1, 15))).Value
                                 ActiveCell.EntireRow.Select
                                 Selection.Delete Shift:=xlUp
End Sub

Sub D_cut()
ActiveCell.Offset(-1, 0).Range(Cells(1, 61), (Cells(1, 75))).Value = ActiveCell.Range(Cells(1, 1), (Cells(1, 15))).Value
                                 ActiveCell.EntireRow.Select
                                 Selection.Delete Shift:=xlUp
End Sub

Sub E_cut()
ActiveCell.Offset(-1, 0).Range(Cells(1, 76), (Cells(1, 90))).Value = ActiveCell.Range(Cells(1, 1), (Cells(1, 15))).Value
                                 ActiveCell.EntireRow.Select
                                 Selection.Delete Shift:=xlUp
End Sub

Sub H_Skip()
ActiveCell.Offset(1, 0).Select
End Sub

Sub T_Skip()
ActiveCell.Offset(1, 0).Select
End Sub

Sub Delete_row()
  ActiveCell.EntireRow.Select
  Selection.Delete Shift:=xlUp
End Sub

'Sub c_msg()
' MsgBox ("hello Msg")
'End Sub

[SamT]

What do you mean "it doesn't work properly"? What does it do or not do?

You have three "Skip" Subs. You only need one.

One problem I see is that in a loop, you must delete rows from the bottom up.

If you loop with For u = Trans_count to 2 step - 1 you can refer to the cell to work with by using Cells(u, 1)

When you find a "U" cell, you can use an other loop to find the last "S" Cell under it

s = 0
Do while Left(Cells(u + s, 1), 1) <> "U"
s =s + 1
Loop

Then loop backwards thru them:

For s = s to 0 Step - 1
Cells(u + s, 1)
Next

To skip a Row, use i = i - 1

Work on your code using these tips and get back to us. There are other tips that can make your code more efficient and easier to understand.