Snasui Excel Forum

Code: Select all

Sub SETN()
    
    ''Set N for 1st row------------------------------------------------------------------------------------------------
    If Range("A2") = "" Then
        Rows("2:2").Select
        Selection.Delete Shift:=xlUp
    Else
        If Left(Range("A2"), 1) <> "N" Then
            Range("A2").Select
            Range(Selection, Selection.End(xlToRight)).Select
            Selection.Cut
 
            Range("A1").Select
            Range("A1").End(xlToRight).Offset(0, 1).Select

            ActiveSheet.Paste
            Rows("2:2").Select
            Selection.Delete Shift:=xlUp
    Else
        
    ''Set N for 2nd row------------------------------------------------------------------------------------------------
    If Range("A3") = "" Then
        Rows("3:3").Select
        Selection.Delete Shift:=xlUp
    Else
        If Left(Range("A3"), 1) <> "N" Then
            Range("A3").Select
            Range(Selection, Selection.End(xlToRight)).Select
            Selection.Cut
            'Need next cell fomular here '
            Range("A2").Select
            Range("A2").End(xlToRight).Offset(0, 1).Select
            'Need next cell fomular here '
            ActiveSheet.Paste
            Rows("3:3").Select
            Selection.Delete Shift:=xlUp
    Else
    
    ''Set N for 3rd row------------------------------------------------------------------------------------------------
    If Range("A4") = "" Then
        Rows("4:4").Select
        Selection.Delete Shift:=xlUp
    Else
        If Left(Range("A4"), 1) <> "N" Then
            Range("A4").Select
            Range(Selection, Selection.End(xlToRight)).Select
            Selection.Cut
            'Need next cell fomular here '
            Range("A3").Select
            Range("A3").End(xlToRight).Offset(0, 1).Select
            'Need next cell fomular here '
            ActiveSheet.Paste
            Rows("4:4").Select
            Selection.Delete Shift:=xlUp
     Else
    
    ''Set N for 4th row------------------------------------------------------------------------------------------------
    If Range("A5") = "" Then
        Rows("5:5").Select
        Selection.Delete Shift:=xlUp
    Else
        If Left(Range("A5"), 1) <> "N" Then
            Range("A5").Select
            Range(Selection, Selection.End(xlToRight)).Select
            Selection.Cut
            'Need next cell fomular here '
            Range("A4").Select
            Range("A4").End(xlToRight).Offset(0, 1).Select
            'Need next cell fomular here '
            ActiveSheet.Paste
            Rows("5:5").Select
            Selection.Delete Shift:=xlUp
    
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If

    
End Sub

Code: Select all

Private Sub CommandButton1_Click()
Dim rn As Range, a(1 To 99, 9999), r&, c&
For Each rn In [A1].CurrentRegion
    If Application.IsText(rn.Value2) Then
        r = r + 1: c = 0
        a(r, c) = rn.Value2
    ElseIf rn.Value2 <> "" Then
        c = c + 1: a(r, c) = rn.Value2
    End If
Next
[A1].CurrentRegion.ClearContents
[A1].Resize(r, 9999) = a
End Sub

Private Sub CommandButton2_Click()
    Sheets("Sheet2").Range("A1:U30").Copy [A1]
End Sub

Code: Select all

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    Grouped = Table.Group(Source, "Column1", {{"T", each (_)}},0,(b,e)=> Number.From(Text.Start(Text.From(e),1)="N")),
    CombineN = Table.AddColumn(Grouped, "R", each List.RemoveNulls(List.Combine(Table.ToRows([T])))),
    Row = Table.Transpose(Table.FromColumns(CombineN[R]))
in
    Row

Code: Select all

Private Sub CommandButton1_Click()
    Dim rall As Range, ra As Range
    Dim r As Range, i As Long
    Dim t As Range, k As Integer
    With Me
        If Application.Sum(.Range("a:a")) = 0 Then Exit Sub
        Set rall = .Range("a:a").SpecialCells(xlCellTypeConstants, 1)
        For i = 1 To rall.Areas.Count
            k = 4
            Set ra = rall.Areas(i)
            For Each r In ra
               Set t = rall.Areas(i).Range("a1").Offset(-1, k)
               t.Resize(1, 3).Value = r.Resize(1, 3).Value
               r.ClearContents
               k = k + 3
            Next r
        Next i
        .Range("a:a").SpecialCells(xlCellTypeBlanks).EntireRow.Delete Shift:=xlUp
    End With
End Sub