Standard numbering

B

Basta1980

Hi,

I have a worksheet called '2. Template nummerlijst'. In this worksheet there
are various columns (A:K) starting on row 9 (row 8 contains headers). I have
1 macro to copy information from a different sheet onto columns B:I. Columns
J:K are blanks. The 2nd macro is used to copy a startdate form a single range
somewhere else in the same workbook and also to calculate an certain amount
to be credited per user. Because the information (size) of columns B:I is a
variable I use the next code to perform the 2nd macro;

Sub Startdate_Amount()

'Check if everything is filled in
If Creditbedrag_per_aansluiting = Range("'2. Template nummerlijst'!N16")
<> 0 Then
MsgBox "Vul eerst creditbedrag per aansluiting in"
Else
'Copy down-date from rng

Dim rng As Range
Set rng = ActiveSheet.Range("J9")

'Get date
Windows("Fin-Cont tool.xls").Activate
Sheets("1. Checklist").Select
Range("B12").Select
Selection.Copy
Windows("Fin-Cont tool.xls").Activate
Sheets("2. Template nummerlijst").Select
Range("J9").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats

'copy date down active content
rng.Copy Destination:=Range(rng, rng.Offset(0, -1).End(xlDown).Offset(0, 1))

'adjust lining to cel J8
Range("J8").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
'adjust alignment
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

'Macro_om_te_crediteren_bedrag_per_aansluiting_te_genereren
Dim rnga As Range
Set rnga = ActiveSheet.Range("K9")

'Get amount

Prorato = Range("'2. Template nummerlijst'!N15").Text
Creditbedrag_per_aansluiting = Range("'2. Template nummerlijst'!N16").Value
Looptijd_contract = Range("'1. Checklist'!B14").Value
Looptijd_Gemini = Range("'2. Template nummerlijst'!I9").Value

Te_crediteren = Range("'2. Template nummerlijst'!K9").Select
If Prorato <> "Yes" Then
Range("'2. Template nummerlijst'!k9") = Range("'2. Template
nummerlijst'!N16").Value
Else
Range("'2. Template nummerlijst'!k9") = (Creditbedrag_per_aansluiting /
Looptijd_contract) * Looptijd_Gemini
End If

rnga.AutoFill Range(rnga, rnga.Offset(0, -1).End(xlDown).Offset(0, 1))
End If
End Sub

Now I want to use same sort of code to create a standard numbering starting
from cel A9 to whatever the length of the list (columns B:I) is. I tried it
with macro recorder, but because I need a variable I reckon this won't help
because in the recorder the absolute cel reference is displayed. Someone have
any suggestions?!
 
J

Jim Rech

I'm not sure what 'standard numbers' are but here's an example of filling in
1,2,3, etc down from A9 based on the length of entries in (for example)
column C:

Sub Example()
FillNumbers Range("A9"), Range("C9")
End Sub

Sub FillNumbers(NumCell As Range, RefCell As Range)
Dim NumRows As Integer
NumCell.Value = 1
NumRows = Range(RefCell, RefCell.End(xlDown)).Rows.Count
NumCell.AutoFill NumCell.Resize(NumRows), xlFillSeries
End Sub

Just for your information, this code:

Windows("Fin-Cont tool.xls").Activate
Sheets("1. Checklist").Select
Range("B12").Select
Selection.Copy
Windows("Fin-Cont tool.xls").Activate
Sheets("2. Template nummerlijst").Select
Range("J9").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats

can be better written:

Sheets("1. Checklist").Range("B12").Copy
Sheets("2. Template nummerlijst").Range("J9").PasteSpecial
Paste:=xlPasteValuesAndNumberFormats

I'm assuming the workbook Fin-Cont tool.xls is already active.
No need to select sheets or cells to copy from them. The Macro recorder
produces a lot of junk.
--
Jim
| Hi,
|
| I have a worksheet called '2. Template nummerlijst'. In this worksheet
there
| are various columns (A:K) starting on row 9 (row 8 contains headers). I
have
| 1 macro to copy information from a different sheet onto columns B:I.
Columns
| J:K are blanks. The 2nd macro is used to copy a startdate form a single
range
| somewhere else in the same workbook and also to calculate an certain
amount
| to be credited per user. Because the information (size) of columns B:I is
a
| variable I use the next code to perform the 2nd macro;
|
| Sub Startdate_Amount()
|
| 'Check if everything is filled in
| If Creditbedrag_per_aansluiting = Range("'2. Template
nummerlijst'!N16")
| <> 0 Then
| MsgBox "Vul eerst creditbedrag per aansluiting in"
| Else
| 'Copy down-date from rng
|
| Dim rng As Range
| Set rng = ActiveSheet.Range("J9")
|
| 'Get date
| Windows("Fin-Cont tool.xls").Activate
| Sheets("1. Checklist").Select
| Range("B12").Select
| Selection.Copy
| Windows("Fin-Cont tool.xls").Activate
| Sheets("2. Template nummerlijst").Select
| Range("J9").Select
| Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
|
| 'copy date down active content
| rng.Copy Destination:=Range(rng, rng.Offset(0, -1).End(xlDown).Offset(0,
1))
|
| 'adjust lining to cel J8
| Range("J8").Select
| Selection.Borders(xlDiagonalDown).LineStyle = xlNone
| Selection.Borders(xlDiagonalUp).LineStyle = xlNone
| With Selection.Borders(xlEdgeLeft)
| .LineStyle = xlContinuous
| .Weight = xlMedium
| .ColorIndex = xlAutomatic
| End With
| With Selection.Borders(xlEdgeTop)
| .LineStyle = xlContinuous
| .Weight = xlMedium
| .ColorIndex = xlAutomatic
| End With
| With Selection.Borders(xlEdgeBottom)
| .LineStyle = xlContinuous
| .Weight = xlMedium
| .ColorIndex = xlAutomatic
| End With
| With Selection.Borders(xlEdgeRight)
| .LineStyle = xlContinuous
| .Weight = xlMedium
| .ColorIndex = xlAutomatic
| End With
| 'adjust alignment
| With Selection
| .HorizontalAlignment = xlRight
| .VerticalAlignment = xlBottom
| .WrapText = False
| .Orientation = 0
| .AddIndent = False
| .IndentLevel = 0
| .ShrinkToFit = False
| .ReadingOrder = xlContext
| .MergeCells = False
| End With
|
| 'Macro_om_te_crediteren_bedrag_per_aansluiting_te_genereren
| Dim rnga As Range
| Set rnga = ActiveSheet.Range("K9")
|
| 'Get amount
|
| Prorato = Range("'2. Template nummerlijst'!N15").Text
| Creditbedrag_per_aansluiting = Range("'2. Template
nummerlijst'!N16").Value
| Looptijd_contract = Range("'1. Checklist'!B14").Value
| Looptijd_Gemini = Range("'2. Template nummerlijst'!I9").Value
|
| Te_crediteren = Range("'2. Template nummerlijst'!K9").Select
| If Prorato <> "Yes" Then
| Range("'2. Template nummerlijst'!k9") = Range("'2. Template
| nummerlijst'!N16").Value
| Else
| Range("'2. Template nummerlijst'!k9") = (Creditbedrag_per_aansluiting /
| Looptijd_contract) * Looptijd_Gemini
| End If
|
| rnga.AutoFill Range(rnga, rnga.Offset(0, -1).End(xlDown).Offset(0, 1))
| End If
| End Sub
|
| Now I want to use same sort of code to create a standard numbering
starting
| from cel A9 to whatever the length of the list (columns B:I) is. I tried
it
| with macro recorder, but because I need a variable I reckon this won't
help
| because in the recorder the absolute cel reference is displayed. Someone
have
| any suggestions?!
|
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

help needed with borders 2
Hlp! Adv Filter - Non-Contiguous rows don't copy 11
Help with macro 1
Formatting stop when reach blank cell 6
Loops through Sheets but doesn't work. 5
Border formatting row of cells 22
Macro to sort, format, sum, a dynamic set of data 2
Change code help 0

Top