Macros to auto fill series of data

[Monke92]

Hi, I found this macros in another thread and it got me halfway to where I need to be.

The data in cells A and B are codes with A being the beginning and B being the end, a ‘from thru’ set of data. I need to list every number in the range. So cell C I was able to calculate the difference and use that with the previous macro to insert rows and copy down the pricing. But I would like to be able to fill the series of data in column A as well without having to drag down and fill each one. The amount of codes that can be filled in can vary from 1 to 100+.

 

[Joe4]

So I assume that what you posted is your expected result.
Can you post an image of what the data looks like from the start?
What row does the data start on?
Do you really need the value in column C, or was that just done to assist you in expanding the data?

 

[Monke92]

So I assume that what you posted is your expected result.
Can you post an image of what the data looks like from the start?
What row does the data start on?
Do you really need the value in column C, or was that just done to assist you in expanding the data?

Here’s what it looks like before the macro (different section) I was able to use and without the formula in column C. Column C was to help in determining how many rows needed to be added for the codes.

 

[Monke92]

So I assume that what you posted is your expected result.
Can you post an image of what the data looks like from the start?
What row does the data start on?
Do you really need the value in column C, or was that just done to assist you in expanding the data?

Sorry here’s the image

 

[Joe4]

I see a critical detail that was not mentioned. It looks like the values in columns A and B could actually be alphanumeric.
For the alphanumeric entries, will the letters ONLY appear at the beginning of the entry, and will it only be the first characters?
Or are other alphanumeric formats possible (please supply us with all the different options)?

 

[Monke92]

I see a critical detail that was not mentioned. It looks like the values in columns A and B could actually be alphanumeric.
For the alphanumeric entries, will the letters ONLY appear at the beginning of the entry, and will it only be the first characters?
Or are other alphanumeric formats possible (please supply us with all the different options)?

Yes, the alphanumeric entries only have a letter in the first character.

 

[Joe4]

Try this VBA code:

Sub MyFillSeries()

    Dim lr As Long
    Dim r As Long
    Dim a As Byte
    Dim p As String
    Dim n1 As Long
    Dim n2 As Long
    Dim i As Long
    
    Application.ScreenUpdating = False
    
'   Find last row with data in column A
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through rows backwards, starting from last row up to row 1
    For r = lr To 1 Step -1
'       Get ASCII value of first character of value in column A
        a = Asc(Left(Cells(r, "A"), 1))
'       See if first character is a number
        If (a >= 49) And (a <= 57) Then
'           Get first and last numbers
            p = ""
            n1 = Cells(r, "A").Value
            n2 = Cells(r, "B").Value
        Else
'           Get first and last numbers after string
            p = Left(Cells(r, "A"), 1)
            n1 = Mid(Cells(r, "A"), 2) + 0
            n2 = Mid(Cells(r, "B"), 2) + 0
        End If
'       Determine if new rows need to be inserted
        If n2 > n1 Then
'           Insert new rows
            Rows(r + 1 & ":" & r + n2 - n1).Insert
'           Populate values of new rows
            For i = 1 To (n2 - n1)
                Cells(r + i, "A").Value = p & (n1 + i)
                Cells(r + i, "C").Value = Cells(r, "C")
                Cells(r + i, "D").Value = Cells(r, "D")
            Next i
        End If
    Next r
    
    Application.ScreenUpdating = True
    
End Sub

 

[Monke92]

Try this VBA code:

Sub MyFillSeries()

    Dim lr As Long
    Dim r As Long
    Dim a As Byte
    Dim p As String
    Dim n1 As Long
    Dim n2 As Long
    Dim i As Long
   
    Application.ScreenUpdating = False
   
'   Find last row with data in column A
    lr = Cells(Rows.Count, "A").End(xlUp).Row
   
'   Loop through rows backwards, starting from last row up to row 1
    For r = lr To 1 Step -1
'       Get ASCII value of first character of value in column A
        a = Asc(Left(Cells(r, "A"), 1))
'       See if first character is a number
        If (a >= 49) And (a <= 57) Then
'           Get first and last numbers
            p = ""
            n1 = Cells(r, "A").Value
            n2 = Cells(r, "B").Value
        Else
'           Get first and last numbers after string
            p = Left(Cells(r, "A"), 1)
            n1 = Mid(Cells(r, "A"), 2) + 0
            n2 = Mid(Cells(r, "B"), 2) + 0
        End If
'       Determine if new rows need to be inserted
        If n2 > n1 Then
'           Insert new rows
            Rows(r + 1 & ":" & r + n2 - n1).Insert
'           Populate values of new rows
            For i = 1 To (n2 - n1)
                Cells(r + i, "A").Value = p & (n1 + i)
                Cells(r + i, "C").Value = Cells(r, "C")
                Cells(r + i, "D").Value = Cells(r, "D")
            Next i
        End If
    Next r
   
    Application.ScreenUpdating = True
   
End Sub

Getting runtime error 13 for the n2= Mid(Cells(r, “B”), 2+0

 

[Joe4]

OK, I suspect some funky data.

I added some error handling code:

Sub MyFillSeries()

    Dim lr As Long
    Dim r As Long
    Dim a As Byte
    Dim p As String
    Dim n1 As Long
    Dim n2 As Long
    Dim i As Long
   
    Application.ScreenUpdating = False
   
'   Find last row with data in column A
    lr = Cells(Rows.Count, "A").End(xlUp).Row
   
    On Error GoTo err_chk
   
'   Loop through rows backwards, starting from last row up to row 1
    For r = lr To 1 Step -1
'       Get ASCII value of first character of value in column A
        a = Asc(Left(Cells(r, "A"), 1))
'       See if first character is a number
        If (a >= 49) And (a <= 57) Then
'           Get first and last numbers
            p = ""
            n1 = Cells(r, "A").Value
            n2 = Cells(r, "B").Value
        Else
'           Get first and last numbers after string
            p = Left(Cells(r, "A"), 1)
            n1 = Mid(Cells(r, "A"), 2) + 0
            n2 = Mid(Cells(r, "B"), 2) + 0
        End If
'       Determine if new rows need to be inserted
        If n2 > n1 Then
'           Insert new rows
            Rows(r + 1 & ":" & r + n2 - n1).Insert
'           Populate values of new rows
            For i = 1 To (n2 - n1)
                Cells(r + i, "A").Value = p & (n1 + i)
                Cells(r + i, "C").Value = Cells(r, "C")
                Cells(r + i, "D").Value = Cells(r, "D")
            Next i
        End If
    Next r
   
    Application.ScreenUpdating = True
    
    Exit Sub
    
    
err_chk:
    If Err.Number = 13 Then
        MsgBox "Error on row " & r, vbOKOnly
    Else
        MsgBox Err.Number & ":" & Err.Description
    End If
    Application.ScreenUpdating = True
       
End Sub

If you run it again, it should tell you what row the error is occurring on.
Tell us exactly what is in column A of that particular row.