find and insert missing values

[dekowal3]

Here is a portion of my data set.
A B
244 2
243 2
241 2
240 3
239 1
238 1
235 4
233 5
232 5
226 3
225 3
224 3
223 2


How can I find the missing values in the serial list in Column A an
insert a row (and the missing value) where appropriate?

Thanks
Debbi

 

[Juan Pablo Gonzalez]

How do you know which is the missing value ?

 

[Leo Heuser]

Debbie

Here's one way.

Insert the code below in a general module
(<Alt><F11>, Insert > Module)

Try experimenting with various values
in the variables:

WorkingSheet = "Sheet1"
StartCell = "A1"
NumberOfColumns = 2
Difference = -1

When changing the Difference e.g. to 3, it's
assumed that all numbers in the first column
fit the pattern beforehand. E.g. 456, 462, 465, 474
is OK giving the sequence 456, 459, 462, 465, 468,
471, 474, while 456, 462, 465, 473 is not, because
473 is not in the sequence.



Sub InsertRows()
'Leo Heuser, 22 Apr. 2004
Dim CheckRange As Range
Dim CheckRangeValue As Variant
Dim Counter As Long
Dim Counter1 As Long
Dim Difference As Double
Dim DummyRange As Range
Dim EndNumber As Double
Dim FirstCell As Range
Dim NumberOfColumns As Long
Dim NumberOfRows As Long
Dim ResultValue() As Variant
Dim StartCell As String
Dim StartNumber As Double
Dim WorkingSheet As String

On Error GoTo Finito

WorkingSheet = "Sheet1"
StartCell = "A1"
NumberOfColumns = 2
Difference = -1

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With Sheets(WorkingSheet)
Set FirstCell = .Range(StartCell)
Set CheckRange = Range(FirstCell, _
.Cells(.Rows.Count, FirstCell.Column).End(xlUp))
Set CheckRange = CheckRange.Resize(, NumberOfColumns)

StartNumber = FirstCell.Value
EndNumber = CheckRange.Cells(CheckRange.Rows.Count, 1)
NumberOfRows = Abs(StartNumber - EndNumber) / _
Abs(Difference) + 1

ReDim ResultValue(1 To NumberOfRows, 1 To NumberOfColumns)

ResultValue(1, 1) = StartNumber
CheckRangeValue = CheckRange.Value

For Counter = 1 To UBound(CheckRangeValue, 1)
For Counter1 = 2 To UBound(CheckRangeValue, 2)
ResultValue(Abs(StartNumber - _
CheckRangeValue(Counter, 1)) / _
Abs(Difference) + 1, Counter1) = _
CheckRangeValue(Counter, Counter1)
Next Counter1
Next Counter

FirstCell.Resize(UBound(ResultValue, 1) - _
UBound(CheckRangeValue, 1), 1).EntireRow.Insert

Set DummyRange = .Range(StartCell). _
Resize(UBound(ResultValue, 1), NumberOfColumns)

With DummyRange
.Value = ResultValue
.Columns(1).DataSeries Rowcol:=xlColumns, _
Type:=xlLinear, Step:=Difference
End With
End With

Finito:
If Err.Number > 0 Then
MsgBox "Error." & vbNewLine & Err.Description
End If

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

On Error GoTo 0
End Sub

 

[Dianne Butterworth]

Debbie,

If you don't mind doing a sort on the range, maybe something like this?

Sub CallTheProcedure()
Call FindGaps(Range("A1:A13"))
End Sub

Sub FindGaps(rng As Range)

Dim c As Range
Dim lngCounter As Long

rng.Sort Key1:=rng(1, 1)
lngCounter = rng(1, 1).Value

For Each c In rng
If c.Value <> lngCounter Then
c.Offset(0, 0).Resize(1, 2).Insert _
(xlShiftDown)
c.Offset(-1, 0).Value = lngCounter
End If
lngCounter = lngCounter + 1
Next c

Set c = Nothing

End Sub