Expanding a Data Series using VBA

[gingermonkey17]

Hi All,

I'm not sure this is possible to do but here is definitely the best place to ask.

I currently use a bit of vba code to expand two pieces of data for example:

Cell 1 value: 1
Cell 2 Value: 4

With the vba code this is expanded into further cells to become:

Cell 3 Value: 1
Cell 4 Value: 2
Cell 5 Value: 3
Cell 6 Value: 4

The problem occurs because i want to do this for roughly 1000 rows, I could right the code per row but obviously this is impractical, is there a way to get this done?

Current code below:

Private Sub CommandButton1_Click()
Dim vStop, vStart
    With WorksheetFunction
        Start001 = .Min(Sheet1.Range("G6:H6"))
        Stop001 = .Max(Sheet1.Range("G6:H6"))
    End With
     
    With Sheet1
        .Range("L6") = Start001
        .Range("L6:Z6").DataSeries Step:=1, Stop:=Stop001
    End With
End Sub

Thank you!

 

[JackDanIce]

Welcome to the board. Try:

Private Sub CommandButton1_Click()

Dim vStop As Variant

Application.screenUpdating = False

With Sheet1
    .Range("L6").Value = Application.WorksheetFunction.Min(.Range("G6:H6"))
    vStop = Application.WorksheetFunction.Max(.Range("G6:H6"))
    .Range("L6").Resize(vStop - .Range("L6").Value + 1).DataSeries Step:=1, Stop:=vStop
End With

Application.screenUpdating = True

End Sub

 

[gingermonkey17]

Hi JackDanIce,

Thanks for the reply.

Ideally I want the expanded data to stay in one row, i.e in this case row 6, so the data is expanded into L6, M6, N6, O6

This is because in row 7, 8, 9 etc. there is more data that needs to be expanded in the same way, these may be the same/longer/shorter than the first set of data.

I hope this is clear enough to understand!

Thanks.

 

[JackDanIce]

Just need to add a ',' try:

Private Sub CommandButton1_Click()


Dim vStop As Variant


Application.screenUpdating = False


With Sheet1
    .Range("L6").Value = Application.WorksheetFunction.Min(.Range("G6:H6"))
    vStop = Application.WorksheetFunction.Max(.Range("G6:H6"))
    .Range("L6").Resize(, vStop - .Range("L6").Value + 1).DataSeries Step:=1, Stop:=vStop
End With


Application.screenUpdating = True


End Sub

 

[gingermonkey17]

OK so that now expands the first row perfectly thank you, now how do I extend it to expand anywhere up to 1000 rows?

I say anywhere because it isn't set to 1000 but it could be anywhere up to that amount.

Example:

Row 6: 1 to 5 Expands to 1, 2, 3, 4, 5
Row 7: 8 to 12 Expands to 8, 9, 10, 11, 12
Row 8: 4 to 6 Expands to 4, 5, 6

and so on...

Thanks for your help so far!

 

[hiker95]

gingermonkey17,

Sample raw data:

Excel 2007
	G	H	I	J	K	L	M	N	O	P	Q
6	1	4
7	1	5
8	1	6
9	7	9
10	-1	-5
11
Sheet1

After the macro:

Excel 2007
	G	H	I	J	K	L	M	N	O	P	Q
6	1	4				1	2	3	4
7	1	5				1	2	3	4	5
8	1	6				1	2	3	4	5	6
9	7	9				7	8	9
10	-1	-5				-5	-4	-3	-2	-1
11
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub ExpandDataSeries()
' hiker95, 03/11/2014, ME63357
Dim c As Range, n As Long
Dim MyStart As Long, MyStop As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")
  For Each c In .Range("G6", .Range("G" & Rows.Count).End(xlUp))
    MyStart = WorksheetFunction.Min(.Range(.Cells(c.Row, "G"), .Cells(c.Row, "H")))
    MyStop = WorksheetFunction.Max(.Range(.Cells(c.Row, "G"), .Cells(c.Row, "H")))
    n = (MyStop - MyStart) + 1
    .Range("L" & c.Row) = MyStart
    .Range(.Cells(c.Row, 12), .Cells(c.Row, 12 + n)).DataSeries Step:=1, Stop:=MyStop
  Next c
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ExpandDataSeries macro.

 

[JackDanIce]

Almost identical to hiker's suggestion except it's the code I suggested earlier, adjusted (if you were trying to follow/understand it for continuation purposes)

Private Sub CommandButton1_Click()


Dim vStop As Variant
Dim LR As Long
Dim rng As Range


Application.screenUpdating = False


With Sheet1
    LR = .Range("L" & Rows.Count).End(xlUp).Row
    For Each rng In .Range("L6:L" & LR)
        .Range("L" & rng.Row).Value = Application.WorksheetFunction.Min(rng.Resize(, 2))
        vStop = Application.WorksheetFunction.Max(rng.Resize(, 2))
        .Range("L" & rng.Row).Resize(, vStop - .Range("L" & rng.Row).Value + 1).DataSeries Step:=1, Stop:=vStop
    Next rng
End With


Application.screenUpdating = True


Set rng = Nothing


End Sub

 

[gingermonkey17]

Hi Both,

The solution works brilliantly, absolutely fantastic.

This spreadsheet has the possibility to get a bit more complex yet so hopefully I can call on you two to help me out.

Thanks!

 

[hiker95]

gingermonkey17,

Thanks for the feedback.

You are very welcome. Glad we could help.

And, come back anytime.