CODEWITHSUNDEEP
vbaexcel
drLecter
drLecter

Reputation: 197

List name and numbers between two values

I have been googling a lot and I couldnt make this one work in any way.

I have a table of three columns (Name, Value1, Value2) with lots of names. I need a vba to list all numbers between value 1&2 including them and their respective names.

For example for row A, 3000, 3003 make rows A, 3000; A, 3001; A, 3002; A, 3003 and then continue on the next name and split that name's range into individual numbers.

Is this even possible?

Thank you so much.

Upvotes: 1

Views: 1394

Answers (3)

user4039065
user4039065

Reputation:

I wrote one based on an array to collect then transfer the values.

Sub expandValues()
    Dim i As Long, j As Long, arr As Variant

    With Worksheets("sheet5")
        .Cells(1, "E").Resize(1, 2) = Array("Name", "Value")

        For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            ReDim arr(.Cells(i, "B").Value2 To .Cells(i, "C").Value2, 1 To 2)
            For j = LBound(arr, 1) To UBound(arr, 1)
                arr(j, 1) = .Cells(i, "A").Value2
                arr(j, 2) = j
            Next j
            .Cells(.Rows.Count, "E").End(xlUp).Offset(1, 0). _
              Resize(UBound(arr, 1) - LBound(arr, 1) + 1, UBound(arr, 2)) = arr
        Next i
    End With

End Sub

enter image description here

Addendum:

Here is yours with an outer loop to process through the rows.

Sub FillIN()
    Dim stri As Long, endi As Long
    Dim nm As string, i as long, j as long

    with workSheets(1)
        For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            nm = .Cells(i, "A").Value
            strti = .Cells(i, "B").Value
            endi = .Cells(i, "C").Value

            For j= strti To endi
                .Cells(.Rows.Count, "E").End(xlUp).Offset(1, 0) = nm
                .Cells(.Rows.Count, "E").End(xlUp).Offset(0, 1) = j
            Next j
        next i
    end with

End Sub

Upvotes: 4

QHarr
QHarr

Reputation: 84465

Something like the following?

Option Explicit
Public Sub ListLines()
    Dim ws As Worksheet, i As Long, y As Long, rowCounter As Long
    Application.ScreenUpdating = False
    Set ws = ActiveSheet: rowCounter = 1
    With ws
        For i = 2 To GetLastRow(ws, 1)
            For y = .Cells(i, 2) To .Cells(i, 3)
                .Cells(rowCounter, 5) = .Cells(i, 1)
                .Cells(rowCounter, 6) = y
                 rowCounter = rowCounter + 1
            Next y
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

Public Function GetLastRow(ByVal ws As Worksheet, ByVal columNum As Long) As Long
    With ws
        GetLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
End Function

Upvotes: 2

drLecter
drLecter

Reputation: 197

This is what I have so far. And it semi works. I need to make it jump on the next line ( it just repeats the first one forever ) and make it stop when done. I havent been able to make it add +1 on the row portion of (Row, Column) in starti and endi and Name i after it is done with first row range. Mine also runs indefinitely so I also miss a stop once done.

Sub FillIN()

Dim ws As Worksheet
Dim stri As Long, endi As Long
Dim Name As Variant

Set ws = Sheets(1)
Name = Sheets(1).Cells(2, 1).Value
strti = Sheets(1).Cells(2, 2).Value
endi = Sheets(1).Cells(2, 3).Value

For i = strti To endi
ws.Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).Value = i
ws.Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Value = Name
Next i

End Sub

Upvotes: 1

Related Questions