View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Leo Heuser[_3_] Leo Heuser[_3_] is offline
external usenet poster
 
Posts: 109
Default find and insert missing values

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


--
Best Regards
Leo Heuser

Followup to newsgroup only please.

"dekowal3 " skrev i en meddelelse
...
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 and
insert a row (and the missing value) where appropriate?

Thanks
Debbie


---
Message posted from http://www.ExcelForum.com/