Consulting

Results 1 to 19 of 19

Thread: Inserting Rows based on cell differences and interpolating in between

  1. #1

    Question 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.


    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

  2. #2
    Example Input v30kz6.jpg

    Desired output: 2hrod4n.jpg

  3. #3
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,625
    Please post a sample Excel file instead of pictures.
    Why should you bother helpers with creating a workbook you already have available ?

  4. #4
    Sorry!
    Here it is.
    Attached Files Attached Files

  5. #5
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,845
    try on your test file:
    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
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  6. #6
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,845
    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

  7. #7
    Thank you very much p45cal. It worked perfectly, but it gives: Run time error"1004" after completing.
    Here's the full 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

  8. #8
    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----
    Last edited by unknown_mem; 08-22-2016 at 04:07 AM.

  9. #9
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,845
    You don't need any code after 'Application.ScreenUpdating=True.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

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

  11. #11
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,845
    Quote Originally Posted by p45cal View Post
    You don't need any code after 'Application.ScreenUpdating=True.
    …nor before 'Application.ScreenUpdating=False.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  12. #12
    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?

  13. #13
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,845
    try:
    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
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  14. #14
    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.

  15. #15

    Exclamation Modifying the macro?

    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..

  16. #16
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,845
    1 question: do the values in column B ALWAYS increase as you go down?
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

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

  18. #18
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,845
    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:
    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.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  19. #19
    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •