Add missing numbers in a sequence

[jack]

I have data (example as shown below) that exports from a database in excel
file format on a daily basis.
What I need to do is insert the missing sequential numbers (starting with
001 and ending with 150) in each cell in column A and add a value of zero
for the missing sequential numbers in column B.
I'm at a loss as how to do this!
How I can accomplish with VBA (or another method) ?
Thanks..
Jack

A B
004 67
005 11
006 30
007 14
008 3
009 2
010 1
011 9
014 5
015 12
016 1
018 73
021 28
022 4
024 2
025 1
026 3
027 23
033 1
035 2
036 1
038 12
040 1
044 5
047 1
051 31
052 5
055 1
056 3
057 2
060 26
066 1
067 1
072 14
073 6
080 6
081 2
082 41
088 8
089 1
091 28
092 1
102 1
103 1
104 1
118 2

 

[Tim Williams]

Try this:


'************************************
Sub tester()
Dim x As Long, val As String
Dim rngFind As Range

With ActiveSheet
Set rngFind = .Range(.Range("A2"), _
.Range("A2").End(xlDown))

End With

For x = 1 To 150
val = Right("000" & x, 3)
If rngFind.Find(val, , xlValues, xlWhole) Is Nothing Then
With ActiveSheet.Range("A2").End(xlDown).Offset(1, 0)
.NumberFormat = "@"
.Value = val
.Offset(0, 1).Value = 0
End With
End If
Next x

End Sub
'**********************************

Tim

 

[Per Jessen]

Hi Jack

Try this:

Sub aaa()
'Dim myArr
Dim rng As Range
Set rng = Range("A1", Range("B1").End(xlDown))
myArr = Array(rng.Value)
rCount = Range("A1").End(xlDown).Row
Range("A1") = 1
Range("A2") = 2
Range("A1:A2").Select
Selection.AutoFill Destination:=Range("A1:A150"), Type:=xlFillDefault
Range("B1:B150") = 0
For r = 1 To rCount
Cells(myArr(0)(r, 1), 2) = myArr(arr)(r, 2)
Next
Columns("A").NumberFormat = "###000"
End Sub

Regards,
Per

 

[jack]

I'm having a difficult time with issue.
The database output has changed in two different ways:
1)The event output (column A) for each row is now preceeded with a "C-"
followed by a number or a "CC-" followed by a number.
2)There two different groups of events with event numbers (column A)
repeating and different quantities for the repeating groups.

As in the original post, I need to do is insert the missing sequential
numbers (starting with C-001 and ending with C-150 also CC-001 and ending
with CC-030) in each cell in column A and add a value of zero
for the missing sequential numbers in column B. In addition, I need to add
together the values of the repeating events. The result to be a listing of
events and values (added together where required for duplicate event
numbers) with a value of zero for those missing event numbers.
Any help will be greatly appreciated!!!
Sample data follows.
Thanks.....
Jack

Group A
A B
C - 003 153
C - 004 45
C - 005 2
C - 006 18
C - 008 9
C - 009 4
C - 010 2
C - 011 1
C - 013 3
C - 014 1
C - 015 1
C - 016 1
C - 017 1
C - 021 17
C - 022 1
C - 026 9
C - 028 1
C - 030 19
C - 031 7
C - 034 1
C - 039 1
C - 047 3
C - 048 9
C - 049 6
C - 051 3
C - 058 2
C - 064 8
C - 065 1
C - 110 17
C - 111 1
C - 112 18
C - 114 1
C - 117 1
C - 119 5
C - 120 1
C - 134 1
C - 135 1
CC - 003 5
CC - 004 3
CC - 011 3
group B
C - 003 1
C - 008 1
C - 009 1
C - 021 2
C - 051 2
C - 111 1
I have data (example as shown below) that exports from a database in excel
file format on a daily basis.
What I need to do is insert the missing sequential numbers (starting with
001 and ending with 150) in each cell in column A and add a value of zero
for the missing sequential numbers in column B.
I'm at a loss as how to do this!
How I can accomplish with VBA (or another method) ?
Thanks..
Jack

A B
004 67
005 11
006 30
007 14
008 3
009 2
010 1
011 9
014 5
015 12
016 1
018 73
021 28
022 4
024 2
025 1
026 3
027 23
033 1
035 2
036 1
038 12
040 1
044 5
047 1
051 31
052 5
055 1
056 3
057 2
060 26
066 1
067 1
072 14
073 6
080 6
081 2
082 41
088 8
089 1
091 28
092 1
102 1
103 1
104 1
118 2

 

[Tim Williams]

Sub Tester()
Dim oDict As Object
Dim c As Range, v, k, x As Integer

Set oDict = CreateObject("scripting.dictionary")

For Each c In ActiveSheet.Range("A2:A400")
v = Trim(c.Value)
If (v Like "C - *") Or (v Like "CC - *") Then
If oDict.exists(v) Then
oDict(v) = oDict(v) + c.Offset(0, 1).Value
Else
oDict.Add v, c.Offset(0, 1).Value
End If
End If
Next c

Set c = ActiveSheet.Range("E2") 'or wherever...
For x = 1 To 150
v = "C - " & Right("00" & x, 3)
c.Value = v
c.Offset(0, 1).Value = IIf(oDict.exists(v), oDict(v), 0)
Set c = c.Offset(1, 0)
Next x
For x = 1 To 150
v = "CC - " & Right("00" & x, 3)
c.Value = v
c.Offset(0, 1).Value = IIf(oDict.exists(v), oDict(v), 0)
Set c = c.Offset(1, 0)
Next x

End Sub


Tim

 

[jack]

Thanks Tim,
I'll give a try later on today.
Jack

Sub Tester()
Dim oDict As Object
Dim c As Range, v, k, x As Integer

Set oDict = CreateObject("scripting.dictionary")

For Each c In ActiveSheet.Range("A2:A400")
v = Trim(c.Value)
If (v Like "C - *") Or (v Like "CC - *") Then
If oDict.exists(v) Then
oDict(v) = oDict(v) + c.Offset(0, 1).Value
Else
oDict.Add v, c.Offset(0, 1).Value
End If
End If
Next c

Set c = ActiveSheet.Range("E2") 'or wherever...
For x = 1 To 150
v = "C - " & Right("00" & x, 3)
c.Value = v
c.Offset(0, 1).Value = IIf(oDict.exists(v), oDict(v), 0)
Set c = c.Offset(1, 0)
Next x
For x = 1 To 150
v = "CC - " & Right("00" & x, 3)
c.Value = v
c.Offset(0, 1).Value = IIf(oDict.exists(v), oDict(v), 0)
Set c = c.Offset(1, 0)
Next x

End Sub


Tim

 

[jack]

Thanks Tim,
The code worked great!!
Jack

Sub Tester()
Dim oDict As Object
Dim c As Range, v, k, x As Integer

Set oDict = CreateObject("scripting.dictionary")

For Each c In ActiveSheet.Range("A2:A400")
v = Trim(c.Value)
If (v Like "C - *") Or (v Like "CC - *") Then
If oDict.exists(v) Then
oDict(v) = oDict(v) + c.Offset(0, 1).Value
Else
oDict.Add v, c.Offset(0, 1).Value
End If
End If
Next c

Set c = ActiveSheet.Range("E2") 'or wherever...
For x = 1 To 150
v = "C - " & Right("00" & x, 3)
c.Value = v
c.Offset(0, 1).Value = IIf(oDict.exists(v), oDict(v), 0)
Set c = c.Offset(1, 0)
Next x
For x = 1 To 150
v = "CC - " & Right("00" & x, 3)
c.Value = v
c.Offset(0, 1).Value = IIf(oDict.exists(v), oDict(v), 0)
Set c = c.Offset(1, 0)
Next x

End Sub


Tim