Assigning consecutive numbers to certain rows with data

Esinvancouver

New Member
Joined
Nov 24, 2005
Messages
3
Hi. This is my first post. I find that there is a wealth of information on these boards but could not find the answer to my question.

Every month I need to do the same procedure several times, and there must be a way to write a macro for it.

I do accounting and I need to assign a number to each line of my journal entries, which I do in excel. I need to assign consecutive 4-digit numbers in column E for rows that have data in either column C and column D. When there is no data in either column C and column D, column E will be blank. When there is again some data in either column C and column D, column E will be the next number up from the previous one, where the previous number may be one or more rows away. The 4-digit numbers does not necessary start from 0001. It may start from, say, 5602 and is determined by the first number I input in column E. An example is shown below.

(Column A),(Column B),(Column C),(Column D),(Column E)
Entry#1, Cash, 100,(blank), 5602
(blank), Sales, (blank), 100, 5603
To record sales, (blank), (blank), (blank), (blank)
(blank row)
Entry#2, Miscellaneous, 50, (blank), 5604
(blank), Office expense, (blank), (blank), (blank)
(blank), Travel expense, (blank), (blank), (blank)
(blank), Telephone, 20, (blank), 5605
(blank), Cash, (blank), 70, 5606
To record expenses, (blank), (blank), (blank), (blank)
(blank row)
Entry #3, Accounting fees, 150, (blank), 5607
... and so on...

I'm using Excel2002. Any help would be very much appreciated. Thanks a lot!
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
column G instead of E
Code:
Option Explicit

Sub enumerate_data()
Dim LR As Long

Const FR = 2    'first row with data
LR = Columns("C:D").Find("*", [C1], xlFormulas, xlPart, xlByRows, xlPrevious, False, False).Row

With Range(Cells(FR, "G"), Cells(LR, "G"))
.Formula = "=IF(COUNTA(RC[-4]:RC[-3])=0,"""",COUNT(R1C7:R[-1]C)+R1C7)"
.Value = .Value
End With
End Sub
changed
"E" to "G"
and in the formula -2 to -4, -1 to -3 (relative references) and 5 to 7 (absolute reference)

just edit the starting row to your suits (here it is row 2: FR = 2) and put the starting number in the row before it


if you want to stick to the formula, then use
Code:
=IF(COUNTA(C2:D2)=0,"",COUNT($G$1:G1)+$G$1)
I presume you found this :)

kind regards,
Erik
 

Some videos you may like

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

Barrie Davidson

MrExcel MVP
Joined
Feb 10, 2002
Messages
2,330
Esinvancouver said:
Barrie, your macro works like a charm. Unfortunately, I just realized that my numbers need to be generated in column G and not column E, and I don't know how to modify the macro for this. :cry:

Try
Code:
Option Explicit

Sub GenerateNumbers()
'Written by Barrie Davidson
Dim DataRange As Range
Dim FilteredRange As Range, c As Range
Dim LineNumber As Double

Application.DisplayAlerts = False
Rows("1:1").Insert Shift:=xlDown
Range("A1:G1").Formula = "=COLUMN()"
Set DataRange = Range("A1:G" & _
    ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row)
DataRange.Offset(1, 6).Resize(DataRange.Rows.Count - 1, 1).FormulaR1C1 = _
    "=OR(ISBLANK(RC[-4])=FALSE,ISBLANK(RC[-3])=FALSE)"
DataRange.AutoFilter Field:=5, Criteria1:="TRUE"
On Error Resume Next
Set FilteredRange = DataRange.Offset(1, 6).Resize(DataRange.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If FilteredRange Is Nothing Then
    DataRange.Offset(1, 6).Resize(DataRange.Rows.Count - 1, 1).ClearContents
    GoTo ExitRoutine
End If
LineNumber = CDbl(InputBox("Enter beginning line number"))
For Each c In FilteredRange
    c = LineNumber
    LineNumber = LineNumber + 1
Next c
DataRange.AutoFilter Field:=7, Criteria1:="FALSE"
On Error Resume Next
Set FilteredRange = DataRange.Offset(1, 6).Resize(DataRange.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If FilteredRange Is Nothing Then
    GoTo ExitRoutine
Else
    FilteredRange.ClearContents
End If
ExitRoutine:
DataRange.AutoFilter
Rows("1:1").Delete
Application.DisplayAlerts = True

End Sub

Hope this helps
 

Watch MrExcel Video

Forum statistics

Threads
1,123,012
Messages
5,599,337
Members
414,306
Latest member
Dennis_vdw

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top