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 rows 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 inserting the rows, I have to linear interpolate columns C, D & E in the newly created empty rows. 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.

Code:

---

Option ExplicitSub 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

---

Example Input Attachment 16915

Desired output: Attachment 16916

Please post a sample Excel file instead of pictures.
Why should you bother helpers with creating a workbook you already have available ?

Sorry!
Here it is.

try on your test file:

Code:

---

Sub blah()
'Application.ScreenUpdating = False
Dim numRows As Long, lastrw As Long, i As Long
lastrw = Cells(Rows.Count, "A").End(xlUp).Row
Cells(lastrw, 2).Value = Round(Cells(lastrw, 2).Value, 0)  'round bottom-most value' not sure if this is when you want to do the rounding in column B
For i = lastrw To 2 Step -1
  Cells(i - 1, 2).Value = Round(Cells(i - 1, 2).Value, 0)  'not sure if this is when you want to do the rounding in column B
  numRows = Cells(i, 2).Value - Cells(i - 1, 2).Value
  Rows(i).Resize(numRows - 1).Insert
  Cells(i - 1, 2).Resize(numRows + 1, 4).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Trend:=True
Next i
Range(("A1"), Cells(Rows.Count, "A").End(xlUp)).Value = Range("A1").Value
'Application.ScreenUpdating = True
End Sub

---

oh groan, you've cross posted wholesale without telling people:
http://www.mrexcel.com/forum/excel-q...g-between.html
https://groups.google.com/forum/#!to...ng/gjmgjk3KyU8
http://www.excelbanter.com/showthread.php?t=451909
http://www.ozgrid.com/forum/showthread.php?t=200863

Any more?

All forums have similar rules/netiquette; you really should include links to all cross posts.
Have a read of http://www.excelguru.ca/content.php?184

Thank you very much p45cal. It worked perfectly, but it gives: Run time error"1004" after completing.
Here's the full code:

Code:

---

Option Explicit
Sub Test01()
Application.ScreenUpdating = False


Dim r As Long
Dim Rng As Range


Dim Ar As Range
Dim StepValue1
Dim StepValue2
Dim StepValue3
Dim Ar1 As Range
Dim AR2 As Range
 
  'Application.ScreenUpdating = False
    Dim numRows As Long, lastrw As Long, i As Long
    lastrw = Cells(Rows.Count, "A").End(xlUp).Row
    Cells(lastrw, 2).Value = Round(Cells(lastrw, 2).Value, 0) 'round bottom-most value' not sure if this is when you want to do the rounding in column B
    For i = lastrw To 2 Step -1
        Cells(i - 1, 2).Value = Round(Cells(i - 1, 2).Value, 0) 'not sure if this is when you want to do the rounding in column B
        numRows = Cells(i, 2).Value - Cells(i - 1, 2).Value
        Rows(i).Resize(numRows - 1).Insert
        Cells(i - 1, 2).Resize(numRows + 1, 4).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Trend:=True
    Next i
    Range(("A1"), Cells(Rows.Count, "A").End(xlUp)).Value = Range("A1").Value
    'Application.ScreenUpdating = True
 
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

---

I didn't read the rules to be honest. Sorry about that. I will edit the posts and include the related posts.
I apologize if that was not a proper thing to do.
---Can't add the links here----

You don't need any code after 'Application.ScreenUpdating=True.

Thanks again for your help. It works now without any errors.

Quote:

---

Originally Posted by p45cal

You don't need any code after 'Application.ScreenUpdating=True.

---

…nor before 'Application.ScreenUpdating=False.

Thanks p45cal .Also i tried the code if I have -ve values in column B and works perfectly.
But i noticed that if the difference between the values is equal to 1 or less the code stops at that row. Is there a way we can skip not inserting rows at this condition and continue to the next rows?

try:

Code:

---

Sub blah()
'Application.ScreenUpdating = False
Dim numRows As Long, lastrw As Long, i As Long
lastrw = Cells(Rows.Count, "A").End(xlUp).Row
Cells(lastrw, 2).Value = Round(Cells(lastrw, 2).Value, 0)  'round bottom-most value' not sure if this is when you want to do the rounding in column B
For i = lastrw To 2 Step -1
  Cells(i - 1, 2).Value = Round(Cells(i - 1, 2).Value, 0)  'not sure if this is when you want to do the rounding in column B
  numRows = Cells(i, 2).Value - Cells(i - 1, 2).Value
  If numRows > 1 Then
    Rows(i).Resize(numRows - 1).Insert
    Cells(i - 1, 2).Resize(numRows + 1, 4).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Trend:=True
  End If
Next i
Range(("A1"), Cells(Rows.Count, "A").End(xlUp)).Value = Range("A1").Value
'Application.ScreenUpdating = True
End Sub

---

Yeah that works, I will end up with duplicate values in column B (I will try to figure out which row of them I should keep). Many thanks p45cal. I do appreciate your help.

Hi p45cal

• I found out that I need the decimal/fraction.
• I have multiplied column B by 100 then I ran the code you provided.
• Then I created the following formula "=MOD(ROW(A1)-1,100)=0" to filter every 100.
• Then I divided column by 100 again to retain the original values.
• Then I have deleted all the hidden rows, but this is taking a lot of time since I have +90 worksheets.

The reason I did this is because when I do the rounding, the interpolation is not accurate and I can't use column B with any fractions/decimals.

A bonus would be if I can loop this for all worksheets inside the file, I tried doing this through calling function but it didn't work..

1 question: do the values in column B ALWAYS increase as you go down?

I have reviewed most of the sheets and yes they increase. However some sheets start with -ve values (i.e. -33, -30, -26...etc).

Doing it your way is straightforward and handles many possibilities correctly although it does take time. Here's your way coded. Take a careful note of the comments in the code re which sheets are processed. It works on the active workbook, so make sure that is active before you run macro zz which calls the other:

Code:

---

Sub blah3()
Range("H1") = 100
Range("H1").Copy
Range("A1").CurrentRegion.Columns(2).PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply

Dim numRows As Long, lastrw As Long, i As Long
lastrw = Cells(Rows.Count, "A").End(xlUp).Row
For i = lastrw To 2 Step -1
  numRows = Cells(i, 2).Value - Cells(i - 1, 2).Value
  If numRows > 1 Then
    Rows(i).Resize(numRows - 1).Insert
    Cells(i - 1, 2).Resize(numRows + 1, 4).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Trend:=True
  End If
Next i
Range(("A1"), Cells(Rows.Count, "A").End(xlUp)).Value = Range("A1").Value

Range("H1") = 100
Range("H1").Copy
Range("A1").CurrentRegion.Columns(2).PasteSpecial Paste:=xlPasteValues, Operation:=xlDivide
Range("A1").CurrentRegion.Columns(1).Offset(, 5).FormulaR1C1 = "=INT(RC[-4])=RC[-4]"
Rows("1:1").Insert
Range("A1:F1").Value = "hdr"
Range("A1").AutoFilter field:=6, Criteria1:="FALSE"
Range("A1").CurrentRegion.Columns(6).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Range("H1").Clear
Columns("F:G").Clear
End Sub
Sub zz()
'Application.ScreenUpdating = False
For Each sht In ActiveWorkbook.Sheets
  If Not (sht.Name = "Test01" Or sht.Name = "Sheet2" Or sht.Name = "Sheet1") Then  'adjust this line to include ALL sheets you do not want to be processed.
    sht.Activate
    blah3
  End If
Next sht
'Application.ScreenUpdating = True
End Sub

---

You can run blah3 on its own if the active sheet is the single sheet you want to process.

Many thanks p45cal. I ran it and it is working perfectly. I will examine all the results thoroughly but it looks perfect.
The amount of time that the macro took to run is indicator to the time saved versus doing it manually. Thanks again for your help.