none
VBA code to sequentially add down a column - dynamically RRS feed

  • Question

  • Hello,

    First set of rows would be AR001, (the number of rowsis dynamic), then followed by a blank row followed by another set of dynamic rows - same number of rows as the first set of rows. This is followed by another set of rows with the same number of rows as the first.  I want to increase the segment sequentially. Example AR001 then there is a blank row then change AR001 in second set of rows until blank row is met to AR002, then there is a blank row and third set of rows are AR001 change to AR003 .. etc for 12 segments.

    Basically high level would be AR001 is created 12 times in a dynamically set of rows with a blank row in between. I want AR001 to remain the same and then second set AR002, third set AR003, fouth set AR004 etc

    Thank you in advance for any replies.



    Thomas Yantorno

    Thursday, September 15, 2016 7:18 PM

Answers

  • Try this macro:

    Sub ChangeNumbering()
        Dim LastRow As Long
        Dim CurRow As Long
        Dim Counter As Long
        Application.ScreenUpdating = False
        Counter = 1
        LastRow = Range("A" & Rows.Count).End(xlUp).Row
        For CurRow = 1 To LastRow
            If Range("A" & CurRow).Value = "" Then
                Counter = Counter + 1
            Else
                Range("A" & CurRow).Value = "AR" & Format(Counter, "000")
            End If
        Next CurRow
        Application.ScreenUpdating = True
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by tyantorno Saturday, September 17, 2016 5:05 PM
    Saturday, September 17, 2016 1:01 PM

All replies

  • Hi tyantorno,

    According to you description, since this screenshot is broken, I have made a sample code, you could refer to them and modify:

    Sub Demo()
       
        Const blanks = 5
        Dim rowsid As String, i As Long, r As Long
        r = 1
        rowsid = Cells(r, 1).Value
        
        For k = 1 To 12
        Do While Cells(r, 1).Value <> ""
           r = r + 1
        Loop
         
         For i = 1 To blanks
            Rows(r).Insert Shift:=xlDown
            Cells(r, 1).Value = Left(rowsid, 5) & k + 1
         Next
            rowsid = Left(rowsid, 5) & k + 1
            r = r + blanks
         Next
         
    End Sub

    The result:

    In addition I suggest that you could provide this screenshot, that will help us resolve your issue.

    Thanks for your understanding.


    Friday, September 16, 2016 3:13 AM
  • Hello David,

    Thank you for the suggestion

    Column A currently is

    AR001

    AR001

    AR001

    empty row

    AR001

    AR001

    AR001

    empty row

    AR001 

    AR001

    AR001

    The results I would like is

    AR001

    AR001

    AR001

    empty row

    AR002

    AR002

    AR002

    empty row

    AR003

    AR003

    AR003

    Thank you so much in advance for all your help. 


    Thomas Yantorno

    Friday, September 16, 2016 3:58 PM
  • You need a sequentially increasing input to be repeated some number of times with a blank row in between.Pls provide the screen shot what you desired output.

    Say it is 4 then you want all input to repeat 4 times with a blank row. Or the 4 or also need to be increased. ?

    It will help David to help you in exact the way you want.


    Best Regards, Asadulla Javed, Jadavpore, Asansol

    Saturday, September 17, 2016 8:58 AM
    Answerer
  • Try this macro:

    Sub ChangeNumbering()
        Dim LastRow As Long
        Dim CurRow As Long
        Dim Counter As Long
        Application.ScreenUpdating = False
        Counter = 1
        LastRow = Range("A" & Rows.Count).End(xlUp).Row
        For CurRow = 1 To LastRow
            If Range("A" & CurRow).Value = "" Then
                Counter = Counter + 1
            Else
                Range("A" & CurRow).Value = "AR" & Format(Counter, "000")
            End If
        Next CurRow
        Application.ScreenUpdating = True
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by tyantorno Saturday, September 17, 2016 5:05 PM
    Saturday, September 17, 2016 1:01 PM
  • Hi Hans,

    Thank you so much, works like a dream.


    Thomas Yantorno

    Saturday, September 17, 2016 5:07 PM