Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Based on two cell inputs, I need rest of the cells to give values automatically 1

Status
Not open for further replies.

leatherland

Technical User
May 25, 2015
9
0
0
GB
Hi,

Based on two cell inputs, I need rest of the cells to automatically calculate the differences and input the values.


Scenerio 1:
Eg: If I input '38 in (E1)' and '50 in (K1)', other empty cells from A1 to L1 will calculate and have their respective values automatically.

So, it will look like as below:
A1 B1 C1 D1 E1 F1 G1 H1 I1 J1 K1 L1
30 32 34 36 38 40 42 44 46 48 50 52

Scenerio 2:

Eg: If I input '16.75 in (B1)' and '18.00 in (G1)', other empty cells from A1 to H1 will calculate and have their respective values automatically.

So, it will look like as below:
A1 B1 C1 D1 E1 F1 G1 H1
16.50 16.75 17.00 17.25 17.50 17.75 18.00 18.25


***
 
Here's a macro that will do everthing I think you wanted. Just have your start and end data in Row 1 and it will fill everything before the start (and after the end if you want, just change the more value to be >0)
Code:
Sub fiil2()
Dim row As Integer
Dim icol1 As Integer
Dim icol2 As Integer
Dim maxcol As Integer
Dim incr As Long
Dim i As Integer
Dim more As Integer

Cells(1, 1).Select
row = 1
more = 5 ' change this in case you want to have more data after the known end

If Cells(row, 1).Value = "" Then icol1 = Cells(row, 1).End(xlToRight).Column Else icol1 = 1     ' Find starting Data location
icol2 = Cells(row, icol1).End(xlToRight).Column                                                 ' Find ending Data location
incr = (Cells(row, icol2).Value - Cells(row, icol1).Value) / (icol2 - icol1)                    ' Find data incrament

For i = 1 To icol2 + more
    Cells(row, i).Value = Cells(1, icol1).Value + (i - icol1) * incr                            ' Calculate & Populate cells
Next i

End Sub
 
I'll mention this on the off-chance you're not aware of this built-in Excel functionality. Since you are entering 2 values anyway, instead of entering the first and last values, enter the first 2 values, select them and then grab and drag the fill handle (the little black box in the lower right of the selection) to populate the cells to the maximum value you need. Excel is smart enough to keep incrementing additional cells with the same difference between your first 2 cell values.
 
leatherland,

Here's what you asked for (however, I'm not sure what the first requirement was???)

Code:
Sub FillRange()
'given 2 values in one row, the FIRST and the LAST column values
'  fill the range from the FIRST to the LAST Column

    Dim lRow As Long, i As Long, n
    Dim nDif1               'the difference in the VALUES
    Dim nDif2               'the differeence in the COLUMN
    Dim nDif3               'the incrimental difference
    Dim lRow1 As Long       'first row of the UsedRange
    Dim lRow2 As Long       'last row of the UsedRange
    Dim iCol1 As Integer    'first column with a values in a row
    Dim iCol2 As Integer    'last column with a values in a row
    
    With ActiveSheet.Cells(1, 1).CurrentRegion
        lRow1 = .Row
        lRow2 = .Rows.count + lRow1 - 1
    
        For lRow = 2 To lRow2
            [b]'determine if cells have been filled in-there can only be 2 cells with values
            If Application.count(Cells(lRow, 1).EntireRow) = 2 Then[/b]
            
                'get the two values in row
                'column A is ALWAYS text
                iCol1 = Cells(lRow, "A").End(xlToRight).Column
                iCol2 = Cells(lRow, iCol1).End(xlToRight).Column
                
                [b]'determine if cells have been filled in-the cells cannot be adjacent
                If iCol1 + 1 < iCol2 Then[/b]
                    nDif1 = Cells(lRow, iCol2).Value - Cells(lRow, iCol1).Value
                    nDif2 = iCol2 - iCol1
                    nDif3 = nDif1 / nDif2
                    
                    n = Cells(lRow, iCol1).Value + nDif3
                    For i = iCol1 + 1 To iCol2 - 1
                        Cells(lRow, i).Value = n
                        n = n + nDif3
                    Next
                End If
            End If
        Next
    End With
End Sub
 
Hi,

@SkipVought, that works perfectly alright. Thank you so much for your help :) 5 *****

& @Deniall, DaveInIowa, zelgar Thank you guys for your inputs.

 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top