Expand Serial Number with Model name VBA Code

[moein]

Hey every one i just new in VBA and i need your help as welli have row data file of serial numbers with product name and i want to open it and show data as well in excel with vba here is the sample:

i want to be like this

i use below codes to open serial numbers :

Sub ExpandSeries()    Dim RR$, R&, C As Range    Application.ScreenUpdating = 0    R = Range("A1").CurrentRegion.Rows.Count    RR = "D1" ' Place to Write Results        With Range(RR)        .CurrentRegion.ClearContents ' Clear previous Results        .Resize(2, R) = Application.Transpose(Range("A1").CurrentRegion)        .Offset(2).Resize(, R) = "Series"        .Offset(3).Resize(, R) = .Resize(, R).Value        For Each C In .Offset(3).Resize(, R)            C.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Stop:=C.Offset(-2)        Next C        .CurrentRegion.Columns.AutoFit    End With    Application.ScreenUpdating = 1End Sub

Then i put all the into single column with this code

Sub test()Dim LR As Long, i As LongFor i = 2 To 400    LR = Cells(Rows.Count, i).End(xlUp).Row    Range(Cells(1, i), Cells(LR, i)).Copy Destination:=Cells(Rows.Count, 1).End(xlUp).Offset(1)Next iEnd Sub

i know there should be more easy way to manage this then i would like to ask your help to have easier code,for more detail name of product put in A column , serial start from in B column , Serial End to in C column,thanks for your kind ideas

 

[NdNoviceHlp]

U didn't mention where your data is? I place the raw data in "F" & "G" of sheet 1. Your code posted weird? Anyways, U can trial this. HTH. Dave

Sub Test()
Dim LastRow As Integer, Cnt As Integer, Counter As Integer
With Sheets("Sheet1")
    LastRow = .Range("F" & .Rows.Count).End(xlUp).Row
End With
Sheets("sheet1").Range("A" & 1) = Sheets("sheet1").Range("F" & 1)
Sheets("sheet1").Range("B" & 1) = Sheets("sheet1").Range("G" & 1)
For Cnt = 1 To LastRow - 1
If Sheets("sheet1").Range("F" & Cnt) <> Sheets("sheet1").Range("F" & Cnt + 1) Then
Counter = Counter + 1
Sheets("sheet1").Range("C" & Counter) = Sheets("sheet1").Range("G" & Cnt)
Sheets("sheet1").Range("B" & Counter + 1) = Sheets("sheet1").Range("G" & Cnt + 1)
Sheets("sheet1").Range("A" & Counter + 1) = Sheets("sheet1").Range("F" & Cnt + 1)
End If
Next Cnt
Sheets("sheet1").Range("C" & Counter + 1) = Sheets("sheet1").Range("G" & Cnt)
End Sub

 

[moein]

U didn't mention where your data is? I place the raw data in "F" & "G" of sheet 1. Your code posted weird? Anyways, U can trial this. HTH. Dave

Sub Test()
Dim LastRow As Integer, Cnt As Integer, Counter As Integer
With Sheets("Sheet1")
    LastRow = .Range("F" & .Rows.Count).End(xlUp).Row
End With
Sheets("sheet1").Range("A" & 1) = Sheets("sheet1").Range("F" & 1)
Sheets("sheet1").Range("B" & 1) = Sheets("sheet1").Range("G" & 1)
For Cnt = 1 To LastRow - 1
If Sheets("sheet1").Range("F" & Cnt) <> Sheets("sheet1").Range("F" & Cnt + 1) Then
Counter = Counter + 1
Sheets("sheet1").Range("C" & Counter) = Sheets("sheet1").Range("G" & Cnt)
Sheets("sheet1").Range("B" & Counter + 1) = Sheets("sheet1").Range("G" & Cnt + 1)
Sheets("sheet1").Range("A" & Counter + 1) = Sheets("sheet1").Range("F" & Cnt + 1)
End If
Next Cnt
Sheets("sheet1").Range("C" & Counter + 1) = Sheets("sheet1").Range("G" & Cnt)
End Sub

Product Name in A , Start From In B , End To C

 

[moein]

U didn't mention where your data is? I place the raw data in "F" & "G" of sheet 1. Your code posted weird? Anyways, U can trial this. HTH. Dave

Sub Test()
Dim LastRow As Integer, Cnt As Integer, Counter As Integer
With Sheets("Sheet1")
    LastRow = .Range("F" & .Rows.Count).End(xlUp).Row
End With
Sheets("sheet1").Range("A" & 1) = Sheets("sheet1").Range("F" & 1)
Sheets("sheet1").Range("B" & 1) = Sheets("sheet1").Range("G" & 1)
For Cnt = 1 To LastRow - 1
If Sheets("sheet1").Range("F" & Cnt) <> Sheets("sheet1").Range("F" & Cnt + 1) Then
Counter = Counter + 1
Sheets("sheet1").Range("C" & Counter) = Sheets("sheet1").Range("G" & Cnt)
Sheets("sheet1").Range("B" & Counter + 1) = Sheets("sheet1").Range("G" & Cnt + 1)
Sheets("sheet1").Range("A" & Counter + 1) = Sheets("sheet1").Range("F" & Cnt + 1)
End If
Next Cnt
Sheets("sheet1").Range("C" & Counter + 1) = Sheets("sheet1").Range("G" & Cnt)
End Sub

i test your code it doesn't work its just hide the serial number in middle and doest return like picture in sample,

for better understanding here is the data :

and i want to have VBA like this:

 

[NdNoviceHlp]

The code works if your data was in E & F. What is the outcome? 2 columns of output or 3 columns?. U have changed your request (and none of the numbers match above). Your 1st request was to output product in A, start number in B and end number in C (1 row for each product). This was derived from a 2 column list. Now U have reversed it and I have no idea what U are doing or what the objective is? Good luck. Dave

 

[moein]

The code works if your data was in E & F. What is the outcome? 2 columns of output or 3 columns?. U have changed your request (and none of the numbers match above). Your 1st request was to output product in A, start number in B and end number in C (1 row for each product). This was derived from a 2 column list. Now U have reversed it and I have no idea what U are doing or what the objective is? Good luck. Dave

sorry for my mistake, but i need to expand the serial number for each product, right now its range and i need the serial for each product with the name,

btw thank for your help looks for more detail by others

 

[moein]

sorry for my mistake, but i need to expand the serial number for each product, right now its range and i need the serial for each product with the name,

btw thank for your help looks for more detail by others

I find this article same as my request ; https://www.mrexcel.com/forum/excel-questions/800450-list-numbers-between-two-numbers.html

but the issue is VBA doesnt return the name with each numbers!

any idea guys?

 

[edmitchell]

Hi

Assuming, I understand your revised needs, this should do what you, but like Dave I made some assumptions

File contains 2 tabs,
1st = "RAW Data" which contains your raw data, as shown in the image above (e.g. 3 columns, A,B,C)
2nd = "Output", which will contain the built / created data (and will be emptied by the code)

the code you need is:

Sub test()
'Raw data in tab of "Raw Data"
'Output data to go into tab called "Output", will be emptied


Dim CurrentRow As Integer, OutputRow As Integer
Dim Start_Value As Double, End_Value As Double, Desc As String
Dim I As Double

'Empty Output Tab
Sheets("Output").Activate
Cells.Select
Selection.ClearContents
Columns("B:B").Select
Selection.NumberFormat = "0"


CurrentRow = 1
OutputRow = 1


Do While Sheets("Raw Data").Cells(CurrentRow, 1) <> ""
    Desc = Sheets("Raw Data").Cells(CurrentRow, 1)
    Start_Value = Sheets("Raw Data").Cells(CurrentRow, 2)
    End_Value = Sheets("Raw Data").Cells(CurrentRow, 3)
    
    For I = Start_Value To End_Value
        Sheets("Output").Cells(OutputRow, 1) = Desc
        Sheets("Output").Cells(OutputRow, 2) = I
        OutputRow = OutputRow + 1
    Next


    CurrentRow = CurrentRow + 1


Loop


'expand Output, Column A to maximum length
Columns("A:A").Select
Columns("A:A").EntireColumn.AutoFit
Range("A1").Select


x = MsgBox("Finished")


End Sub

probably not the most eloquent of code, but works


Regards

 

[moein]

Hi

Assuming, I understand your revised needs, this should do what you, but like Dave I made some assumptions

File contains 2 tabs,
1st = "RAW Data" which contains your raw data, as shown in the image above (e.g. 3 columns, A,B,C)
2nd = "Output", which will contain the built / created data (and will be emptied by the code)

the code you need is:

Sub test()
'Raw data in tab of "Raw Data"
'Output data to go into tab called "Output", will be emptied


Dim CurrentRow As Integer, OutputRow As Integer
Dim Start_Value As Double, End_Value As Double, Desc As String
Dim I As Double

'Empty Output Tab
Sheets("Output").Activate
Cells.Select
Selection.ClearContents
Columns("B:B").Select
Selection.NumberFormat = "0"


CurrentRow = 1
OutputRow = 1


Do While Sheets("Raw Data").Cells(CurrentRow, 1) <> ""
    Desc = Sheets("Raw Data").Cells(CurrentRow, 1)
    Start_Value = Sheets("Raw Data").Cells(CurrentRow, 2)
    End_Value = Sheets("Raw Data").Cells(CurrentRow, 3)
    
    For I = Start_Value To End_Value
        Sheets("Output").Cells(OutputRow, 1) = Desc
        Sheets("Output").Cells(OutputRow, 2) = I
        OutputRow = OutputRow + 1
    Next


    CurrentRow = CurrentRow + 1


Loop


'expand Output, Column A to maximum length
Columns("A:A").Select
Columns("A:A").EntireColumn.AutoFit
Range("A1").Select


x = MsgBox("Finished")


End Sub

probably not the most eloquent of code, but works


Regards

Thanks a lot edmitchell works Perfect, Just my data is so huge i changed to Integer to Long and every-things works fine,