Frank Kabel - Multiple Fill Series

[Alec Kolundzic]

Frank

Sorry I did not explain my requirements fully.

I am looking for an Function that will automatically fill
a series of numbers on certain criteria, for instance, for
all the occurances of "DI" in column A, a series should
appear in column B as shown. Column B represents slots of
4 inputs, when each slot is filled the series should
increment to the next slot as shown below:

A1=DI B1=0101
A2=DI B2=0102
A3=DI B3=0103
A4=DI B4=0104
A5=DI B5=0201
A6=DI B6=0202
A7=DI B7=0203
A8=DI B8=0204
A9=DO B9=0901
A10=D0 B10=0902
A11=DO B11=0903
A12=DI B12=0301
A13=DI B13=0302
A14=DO B14=0904

Any ideas
Thanks Alec


..

 

[Frank Kabel]

Hi
first: please stay in the oroginal thread - makes it easier to follow
the question

So in your example I assume that all DI entries start with 0101 and all
DO entries with 0901. Try the following macro (works for 'DI' and 'DO'
entries. Adapt this to your needs):

Sub create_counter()
Dim RowNdx As Long
Dim LastRow As Long
Dim counter(2, 2)

Application.ScreenUpdating = False
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).row
counter(0, 0) = 101
counter(0, 1) = 0
counter(1, 0) = 901
counter(1, 1) = 0

For RowNdx = 1 To LastRow
With Cells(RowNdx, "A")
Select Case .Value
Case "DI"
If counter(0, 1) = 4 Then
counter(0, 1) = 1
counter(0, 0) = counter(0, 0) + 1
Else
counter(0, 1) = counter(0, 1) + 1
End If
.Offset(0, 1).Value = counter(0, 0)
Case "DO"
If counter(1, 1) = 4 Then
counter(1, 1) = 1
counter(1, 0) = counter(1, 0) + 1
Else
counter(1, 1) = counter(1, 1) + 1
End If
.Offset(0, 1).Value = counter(1, 0)
End Select
End With
Next RowNdx
Range("B1:B" & LastRow).NumberFormat = "0000"
Application.ScreenUpdating = True
End Sub

 

[Alec Kolundzic]

Thanks Frank

Your solution works in a fashion, but gives me the
following series:

0101
0101
0101
0101
0102
0102
0102
0102
etc

Instead of:

0101
0102
0103
0104
0201
0202
0203
0204
etc

 

[Frank Kabel]

Hi
sorry, misread your example. Try the following:

Sub create_counter()
Dim RowNdx As Long
Dim LastRow As Long
Dim counter(2, 2)

Application.ScreenUpdating = False
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).row
counter(0, 0) = 100
counter(0, 1) = 0
counter(1, 0) = 900
counter(1, 1) = 0

For RowNdx = 1 To LastRow
With Cells(RowNdx, "A")
Select Case .Value
Case "DI"
If counter(0, 1) = 4 Then
counter(0, 1) = 1
counter(0, 0) = counter(0, 0) + 97
Else
counter(0, 1) = counter(0, 1) + 1
counter(0, 0) = counter(0, 0) + 1
End If
.Offset(0, 1).Value = counter(0, 0)
Case "DO"
If counter(1, 1) = 4 Then
counter(1, 1) = 1
counter(1, 0) = counter(1, 0) + 97
Else
counter(1, 1) = counter(1, 1) + 1
counter(1, 0) = counter(1, 0) + 1
End If
.Offset(0, 1).Value = counter(1, 0)
End Select
End With
Next RowNdx
Range("B1:B" & LastRow).NumberFormat = "0000"
Application.ScreenUpdating = True
End Sub

 

[Alec Kolundzic]

Thanks Frank

This is just what I want, but I need to add another
criteria, ie, fill the series for all instances of DI but
only on condition that the cell in the previous row
contains "box1" eg:

Column A Column B Column C
Box1 DI 010101
Box1 DI 010102
Box2 DI 020101
Box2 DI 020102
etc

Is it possible to modify your previous example to suit

Thanks
Alec

 

[Frank Kabel]

Hi
try the following:

Sub create_counter()
Dim RowNdx As Long
Dim LastRow As Long
Dim counter(2, 2)

Application.ScreenUpdating = False
LastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).row
counter(0, 0) = 100
counter(0, 1) = 0
counter(1, 0) = 900
counter(1, 1) = 0

For RowNdx = 1 To LastRow
With Cells(RowNdx, "B")
If .Offset(0, -1) = "Box1" Then
Select Case .Value
Case "DI"
If counter(0, 1) = 4 Then
counter(0, 1) = 1
counter(0, 0) = counter(0, 0) + 97
Else
counter(0, 1) = counter(0, 1) + 1
counter(0, 0) = counter(0, 0) + 1
End If
.Offset(0, 1).Value = counter(0, 0)
Case "DO"
If counter(1, 1) = 4 Then
counter(1, 1) = 1
counter(1, 0) = counter(1, 0) + 97
Else
counter(1, 1) = counter(1, 1) + 1
counter(1, 0) = counter(1, 0) + 1
End If
.Offset(0, 1).Value = counter(1, 0)
End Select
End If
End With
Next RowNdx
Range("C1:C" & LastRow).NumberFormat = "0000"
Application.ScreenUpdating = True
End Sub

 

[Alec Kolundzic]

Thanks Frank

Your example works a treat.

-----Original Message-----
Hi
try the following:

Sub create_counter()
Dim RowNdx As Long
Dim LastRow As Long
Dim counter(2, 2)

Application.ScreenUpdating = False
LastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).row
counter(0, 0) = 100
counter(0, 1) = 0
counter(1, 0) = 900
counter(1, 1) = 0

For RowNdx = 1 To LastRow
With Cells(RowNdx, "B")
If .Offset(0, -1) = "Box1" Then
Select Case .Value
Case "DI"
If counter(0, 1) = 4 Then
counter(0, 1) = 1
counter(0, 0) = counter(0, 0) + 97
Else
counter(0, 1) = counter(0, 1) + 1
counter(0, 0) = counter(0, 0) + 1
End If
.Offset(0, 1).Value = counter(0, 0)
Case "DO"
If counter(1, 1) = 4 Then
counter(1, 1) = 1
counter(1, 0) = counter(1, 0) + 97
Else
counter(1, 1) = counter(1, 1) + 1
counter(1, 0) = counter(1, 0) + 1
End If
.Offset(0, 1).Value = counter(1, 0)
End Select
End If
End With
Next RowNdx
Range("C1:C" & LastRow).NumberFormat = "0000"
Application.ScreenUpdating = True
End Sub

--
Regards
Frank Kabel
Frankfurt, Germany

Newsbeitrag news:1a02a01c41d6e$0de78020 [email protected]...

.