ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Autofill missing numbers (https://www.excelbanter.com/excel-programming/359074-autofill-missing-numbers.html)

TimE

Autofill missing numbers
 

Is it possible to autofill missing numbers? I will have a sampling a
data by date, but not all days will have data.

2/2/06______100
2/3/06
2/4/06
2/5/06______90
2/6/06______87
2/7/06
2/8/06______79


I would like the data for 2/3 and 2/4 to be filled
(incremented/decremented) in with the assumed data (in this case -
3.333333) and 2/7 with 83. The amount of missing days will be random.

Any help is greatly appreciated.

TimE


--
TimE
------------------------------------------------------------------------
TimE's Profile: http://www.excelforum.com/member.php...fo&userid=2139
View this thread: http://www.excelforum.com/showthread...hreadid=533561


Bob Flanagan

Autofill missing numbers
 
Tim, go to another worksheet and fill in all the dates (type 1/1/06 and drag
down). Then do a Vlookup on the new sheet to the dates and data on the
original sheet and return the data. Use False as the last arguement in the
Vlookup. Some cells will have error values as a matching date was not
found. Select the data column, press F5 and select Special, Formula , Error
values. Press the delete key to delete the values.

To fill in the missing data values, perhaps someone can provide you with a
formula. If not, which is the likely case, please consider the Y Value
Estimator. Details at http://www.add-ins.com/y_value_estimator.htm.

Bob Flanagan
Macro Systems
144 Dewberry Drive
Hockessin, Delaware, U.S. 19707

Phone: 302-234-9857
http://www.add-ins.com
Productivity add-ins and downloadable books on VB macros for Excel

"TimE" wrote in message
...

Is it possible to autofill missing numbers? I will have a sampling a
data by date, but not all days will have data.

2/2/06______100
2/3/06
2/4/06
2/5/06______90
2/6/06______87
2/7/06
2/8/06______79


I would like the data for 2/3 and 2/4 to be filled
(incremented/decremented) in with the assumed data (in this case -
3.333333) and 2/7 with 83. The amount of missing days will be random.

Any help is greatly appreciated.

TimE


--
TimE
------------------------------------------------------------------------
TimE's Profile:
http://www.excelforum.com/member.php...fo&userid=2139
View this thread: http://www.excelforum.com/showthread...hreadid=533561




[email protected]

Autofill missing numbers
 
Hello Tim,

I suggest to use (adjust to interpolate vertical if necessary):

Option Explicit

Enum bg_colours
bg_black = 1
bg_white
bg_red
bg_bright_green
bg_blue
bg_yellow
bg_pink
bg_cyan
bg_dark_red
bg_green
bg_dark_blue
bg_dark_yellow
bg_sky_blue = 33
bg_light_cyan
bg_light_green
bg_light_yellow
bg_pale_blue
bg_rose
bg_lavender
bg_tan
bg_light_blue
bg_aqua
bg_lime
bg_gold
bg_light_orange
bg_orange
bg_blue_grey
bg_grey_40
bg_dark_teal
bg_sea_green
bg_dark_green
bg_olive_green
bg_brown
bg_plum
End Enum


Sub linear_interpolation()
'Performs linear interpolation:
'In each row for empty cells between those with values
'Define area to be interpolated with name "interpolation_data"
'Example: <empty <empty 12 <empty <empty 21 <empty
'Will become: <empty <empty 12 15 18 21 <empty
'Original filled cells will be coloured and different colour
'will be applied for interpolated cell values to be able to
'rerun this program.


Dim i As Long, j As Long, k As Long
Dim CalcModus As Long
Dim UpdateModus As Long
Dim r As Range
Dim d1 As Double, dstep As Double


CalcModus = Application.Calculation
Application.Calculation = xlCalculationManual
UpdateModus = Application.ScreenUpdating
Application.ScreenUpdating = False


Set r = Range("interpolation_data")


For i = 1 To r.Rows.Count
k = 0
Application.StatusBar = "Processing row " & i & " ..."
For j = 1 To r.Columns.Count
If r.Cells(i, j).Interior.ColorIndex < bg_yellow _
And Not IsEmpty(r.Cells(i, j)) Then
If r.Cells(i, j) < "" Then
If k 0 Then
dstep = (r.Cells(i, j).Value - d1) / (j - k)
Do While k + 1 < j
r.Cells(i, k + 1).Formula = r.Cells(i, k) +
dstep
r.Cells(i, k + 1).Interior.ColorIndex =
bg_yellow
k = k + 1
Loop
End If
k = j
r.Cells(i, j).Interior.ColorIndex = bg_lime
d1 = r.Cells(i, j).Value
End If
End If
Next j
Next i


Application.StatusBar = False


Application.Calculation = CalcModus
Application.ScreenUpdating = UpdateModus


End Sub


TimE

Autofill missing numbers
 

Thanks for the reply. Either this is too advanced for me or I am to
stupid to figure out. Probably both. I could not get it to work. I
you feel like teaching me, please reply, if not, then I will be force
to try and figure it out.


Again, thank you for the assistance.


Tim E

--
Tim
-----------------------------------------------------------------------
TimE's Profile: http://www.excelforum.com/member.php...nfo&userid=213
View this thread: http://www.excelforum.com/showthread.php?threadid=53356


[email protected]

Autofill missing numbers
 
Hi Tim,

Quick & dirty:

Push ALT + F11, insert a macro module and paste this:

Option Explicit

Private Enum xlCI 'Excel Color Index
: xlCIBlack = 1: xlCIWhite: xlCIRed: xlCIBrightGreen: xlCIBlue '1 - 5
: xlCIYellow: xlCIPink: xlCITurquoise: xlCIDarkRed: xlCIGreen '6 - 10
: xlCIDarkBlue: xlCIDarkYellow: xlCIViolet: xlCITeal: xlCIGray25 '11 -
15
: xlCIGray50: xlCIPeriwinkle: xlCIPlum: xlCIIvory: xlCILightTurquoise
'16 - 20
: xlCIDarkPurple: xlCICoral: xlCIOceanBlue: xlCIIceBlue: xlCILightBrown
'21 - 25
: xlCIMagenta2: xlCIYellow2: xlCICyan2: xlCIDarkPink: xlCIDarkBrown '26
- 30
: xlCIDarkTurquoise: xlCISeaBlue: xlCISkyBlue: xlCILightTurquoise2:
xlCILightGreen '31 - 35
: xlCILightYellow: xlCIPaleBlue: xlCIRose: xlCILavender: xlCITan '36 -
40
: xlCILightBlue: xlCIAqua: xlCILime: xlCIGold: xlCILightOrange '41 - 45
: xlCIOrange: xlCIBlueGray: xlCIGray40: xlCIDarkTeal: xlCISeaGreen '46
- 50
: xlCIDarkGreen: xlCIGreenBrown: xlCIBrown: xlCIDarkPink2: xlCIIndigo
'51 - 55
: xlCIGray80 '56
End Enum


Sub linear_interpolation(Optional b_horizontal = False)
'Performs linear interpolation:
'In each row for empty cells between those with values
'Define area to be interpolated with name "interpolation_data"
'Example: <empty <empty 12 <empty <empty 21 <empty
'Will become: <empty <empty 12 15 18 21 <empty
'Original filled cells will be coloured and different colour
'will be applied for interpolated cell values to be able to
'rerun this program.

Dim i As Long, j As Long, k As Long
Dim CalcModus As Long
Dim UpdateModus As Long
Dim r As Range
Dim d1 As Double, dstep As Double
Dim lng_FI As Long, lng_SI As Long

CalcModus = Application.Calculation
Application.Calculation = xlCalculationManual
UpdateModus = Application.ScreenUpdating
Application.ScreenUpdating = False

Set r = Range("interpolation_data")
If b_horizontal Then
For i = 1 To r.Rows.Count
k = 0
Application.StatusBar = "Processing row " & i & " ..."
For j = 1 To r.Columns.Count
If r.Cells(i, j).Interior.ColorIndex < xlCIYellow _
And Not IsEmpty(r.Cells(i, j)) Then
If r.Cells(i, j) < "" Then
If k 0 Then
dstep = (r.Cells(i, j).Value - d1) / (j - k)
Do While k + 1 < j
r.Cells(i, k + 1).Formula = r.Cells(i, k) +
dstep
r.Cells(i, k + 1).Interior.ColorIndex =
xlCIYellow
k = k + 1
Loop
End If
k = j
r.Cells(i, j).Interior.ColorIndex = xlCILime
d1 = r.Cells(i, j).Value
End If
End If
Next j
Next i
Else
For i = 1 To r.Columns.Count
k = 0
Application.StatusBar = "Processing column " & i & " ..."
For j = 1 To r.Rows.Count
If r.Cells(j, i).Interior.ColorIndex < xlCIYellow _
And Not IsEmpty(r.Cells(j, i)) Then
If r.Cells(j, i) < "" Then
If k 0 Then
dstep = (r.Cells(j, i).Value - d1) / (j - k)
Do While k + 1 < j
r.Cells(k + 1, i).Formula = r.Cells(k, i) +
dstep
r.Cells(k + 1, i).Interior.ColorIndex =
xlCIYellow
k = k + 1
Loop
End If
k = j
r.Cells(j, i).Interior.ColorIndex = xlCILime
d1 = r.Cells(j, i).Value
End If
End If
Next j
Next i
End If

Application.StatusBar = False

Application.Calculation = CalcModus
Application.ScreenUpdating = UpdateModus

End Sub

Then select your data area (your cells from 100 to 79), then
Insert/Name/Define and name that range "interpolation_data".

Insert a macro button and link it to my program or start the program
manually. Should work - but only if you do not skip a day.

HTH,
Bernd



All times are GMT +1. The time now is 05:58 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com