Remember Me?

#1
Posted to microsoft.public.excel.programming
 external usenet poster Posts: 10
Inserting Rows based on cell differences and interpolating in between

Hello -

I have a complicated issue. I have a file with 5 columns (A, B, C, D, E).
A is fixed string value.
B is a number increasing irregularly.
C, D, E, are given values.

What I need to do is have column B regular (i.e. every 1). So I have to insert columns between B (i.e. B2-B1) will determine how many rows between B1 & B2 and then B3-B2 will determine how many rows between B2 & B3 and so on.
After this inserting the rows, I have to linear interpolate columns C, D & E in the newly create empty columns. In all cases I want to keep the original values and interpolate between them.

The other issue is that column B has decimal/fraction, but I think I can round this to the nearest integer to make it easier for interpolation.

#2
Posted to microsoft.public.excel.programming
 external usenet poster Posts: 10
Inserting Rows based on cell differences and interpolating in between

Input: http://i65.tinypic.com/v30kz6.jpg

Desired output: http://i66.tinypic.com/2hrod4n.jpg
#3
Posted to microsoft.public.excel.programming
 external usenet poster Posts: 10
Inserting Rows based on cell differences and interpolating in between

I tried this one but I think I have a problem with the insert loop!

Option Explicit
Sub Test01()
Application.ScreenUpdating = False
Dim numRows As Long
Dim r As Long
Dim Rng As Range
Dim lastrw As Long
Dim Ar As Range
Dim StepValue1
Dim StepValue2
Dim StepValue3
Dim Ar1 As Range
Dim AR2 As Range

Dim i As Integer
lastrw = Cells(Rows.Count, "A").End(xlUp).Row

i = 1
For i = i + 0 To lastrw Step 1

Set Rng = Range(Cells(i, "A"), Cells(lastrw, "A"))
numRows = Cells(i + 1, 2).Value - Cells(i + 0, 2).Value

For r = Rng.Rows.Count To 1 Step -1
Rng.Rows(r + i).Resize(numRows - 1).EntireRow.Insert
Next r
Next i

Set Rng = Columns(1).SpecialCells(xlBlanks)
For Each Ar In Rng.Areas
Set Ar1 = Ar.Offset(-1, 0).Resize(Ar.Rows.Count + 1)
Set AR2 = Ar1.Resize(Ar1.Rows.Count + 1)

StepValue1 = (AR2(AR2.Count).Offset(0, 2) - _
Ar1(1).Offset(0, 2)) / Ar1.Count

StepValue2 = (AR2(AR2.Count).Offset(0, 3) - _
Ar1(1).Offset(0, 3)) / Ar1.Count

StepValue3 = (AR2(AR2.Count).Offset(0, 4) - _
Ar1(1).Offset(0, 4)) / Ar1.Count

Ar1.Offset(0, 2).DataSeries Rowcol:=xlColumns, _
Type:=xlLinear, Date:=xlDay, _
Step:=StepValue1, Trend:=False

Ar1.Offset(0, 3).DataSeries Rowcol:=xlColumns, _
Type:=xlLinear, Date:=xlDay, _
Step:=StepValue2, Trend:=False

Ar1.Offset(0, 4).DataSeries Rowcol:=xlColumns, _
Type:=xlLinear, Date:=xlDay, _
Step:=StepValue3, Trend:=False

Next

End Sub

#4
Posted to microsoft.public.excel.programming
 external usenet poster Posts: 1,182
Inserting Rows based on cell differences and interpolating in between

Hello -

I have a complicated issue. I have a file with 5 columns (A, B, C, D,
E). A is fixed string value.
B is a number increasing irregularly.
C, D, E, are given values.

What I need to do is have column B regular (i.e. every 1). So I have
to insert columns between B (i.e. B2-B1) will determine how many
rows between B1 & B2 and then B3-B2 will determine how many rows
between B2 & B3 and so on. After this inserting the rows, I have to
linear interpolate columns C, D & E in the newly create empty
columns. In all cases I want to keep the original values and
interpolate between them.

The other issue is that column B has decimal/fraction, but I think I
can round this to the nearest integer to make it easier for
interpolation.

My approach would be to separate adding more rows from the business
logic. I use something like this...

Sub InsertBlankRows(Optional Position As String)
' Inserts a specified number of rows at the location specified.
' If the Position arg is not used then the default is ActiveCell.Row.
Dim vRows As Variant, lPos As Long
Const sMsg As String = "Enter the number of rows to insert."

'Evaluate user input
On Error Resume Next
vRows = InputBox(Prompt:=sMsg, Default:=1): If vRows = "" Then Exit
Sub '//user cancels
If Not Err = 0 Or Not IsNumeric(vRows) Or Not vRows = 1 Then Exit
Sub

'Get the position to insert
lPos = IIf(Position = "Below", lPos + 1, ActiveCell.Row)

'Insert the rows
ActiveSheet.Rows(lPos).Resize(vRows).Insert Shift:=xlDown
End Sub 'InsertBlankRows

...and use it like this...

Dim vAns, sPos\$
vAns = MsgBox("Insert rows ABOVE here?", vbYesNo, "Insert Rows")
sPos = IIf(vAns = vbYes, "Above", "Below")
InsertBlankRows sPos
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
#5
Posted to microsoft.public.excel.programming
 external usenet poster Posts: 1
Inserting Rows based on cell differences and interpolating in between

Could you please explain a little bit this code? Thanks.

#6
Posted to microsoft.public.excel.programming
 external usenet poster Posts: 10
Inserting Rows based on cell differences and interpolating in between

#7
Posted to microsoft.public.excel.programming
 external usenet poster Posts: 10
Inserting Rows based on cell differences and interpolating in between

Other posts I have in other forums - I apologize for not posting these earlier:
http://www.vbaexpress.com/forum/show...tween&p=348053
http://www.mrexcel.com/forum/excel-q...ml#post4612064
#8
Posted to microsoft.public.excel.programming
 external usenet poster Posts: 10
Inserting Rows based on cell differences and interpolating in between

Other posts I have in other forums - I apologize for not posting these earlier:
http://www.mrexcel.com/forum/excel-q...g-between.html
http://www.vbaexpress.com/forum/show...tween&p=348053
http://www.ozgrid.com/forum/showthre...00863&p=776001
#9
Posted to microsoft.public.excel.programming
 external usenet poster Posts: 1,182
Inserting Rows based on cell differences and interpolating in between

Corretion...

Sub InsertBlankRows(Optional Position As String)
' Inserts a specified number of rows at the location specified.
' If the Position arg is not used then the default is ActiveCell.Row.
Dim vRows As Variant, lPos As Long
Const sMsg As String = "Enter the number of rows to insert."

'Evaluate user input
On Error Resume Next
vRows = InputBox(Prompt:=sMsg, Default:=1): If vRows = "" Then Exit
Sub '//user cancels
If Not Err = 0 Or Not IsNumeric(vRows) Or Not vRows = 1 Then Exit
Sub

'Get the position to insert
lPos = ActiveCell.Row: If Position = "Below" Then lPos = lPos + 1

'Insert the rows
ActiveSheet.Rows(lPos).Resize(vRows).Insert Shift:=xlDown
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
#10
Posted to microsoft.public.excel.programming
 external usenet poster Posts: 1,182
Inserting Rows based on cell differences and interpolating in between

Could you please explain a little bit this code? Thanks.

' Inserts a specified number of rows at the location specified.
' If the Position arg is not used then the default is ActiveCell.Row.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

#11
Posted to microsoft.public.excel.programming
 external usenet poster Posts: 1,182
Inserting Rows based on cell differences and interpolating in between

Typo...

Correction...

Sub InsertBlankRows(Optional Position As String)
' Inserts a specified number of rows at the location specified.
' If the Position arg is not used then the default is ActiveCell.Row.
Dim vRows As Variant, lPos As Long
Const sMsg As String = "Enter the number of rows to insert."

'Evaluate user input
On Error Resume Next
vRows = InputBox(Prompt:=sMsg, Default:=1): If vRows = "" Then Exit
Sub '//user cancels
If Not Err = 0 Or Not IsNumeric(vRows) Or Not vRows = 1 Then Exit
Sub

'Get the position to insert
lPos = ActiveCell.Row: If Position = "Below" Then lPos = lPos + 1

'Insert the rows
ActiveSheet.Rows(lPos).Resize(vRows).Insert Shift:=xlDown
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
#12
Posted to microsoft.public.excel.programming
 external usenet poster Posts: 10
Inserting Rows based on cell differences and interpolating in between

Thank you GS. I had help he http://www.vbaexpress.com/forum/show...ing-in-between and it works perfectly now. Thanks again for your help.
#13
Posted to microsoft.public.excel.programming
 external usenet poster Posts: 1,182
Inserting Rows based on cell differences and interpolating in between

Thank you GS. I had help he
http://www.vbaexpress.com/forum/show...ing-in-between
and it works perfectly now. Thanks again for your help.

If you want to run *InsertBlankRows* from a custom menu you can use
this version...

InsertBlankRows CommandBars.ActionControl.Tag
End Sub

With CommandBars("Cell")
.Controls(1).BeginGroup = True
.Caption = "Insert rows below here": .OnAction = "AddMoreRows"
.Tag = "Below": .Style = 1
End With

.Caption = "Insert rows above here": .OnAction = "AddMoreRows"
.Tag = "Above": .Style = 1
End With
End With
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 Posting Rules Smilies are On [IMG] code is On HTML code is OffTrackbacks are On Pingbacks are On Refbacks are On

 Similar Threads Thread Thread Starter Forum Replies Last Post Darwin[_2_] Excel Programming 2 September 25th 09 10:33 AM [email protected] Excel Worksheet Functions 1 July 1st 07 08:44 PM Mike[_77_] Excel Programming 6 April 20th 04 11:14 PM MikeT[_2_] Excel Programming 0 April 20th 04 07:47 PM MikeT[_2_] Excel Programming 4 April 11th 04 10:08 PM

All times are GMT +1. The time now is 08:45 PM.