PDA

View Full Version : Solved: Re-start the value if reached a value



slamet Harto
07-27-2008, 09:49 PM
Dear Expert,

Please have a look on the attachement and run the macro.

I want to re-fresh/re-start the value if the value has reached the target value. In this case, if the target value has reached 36099999999 than it will be re-started from 36000000001, 36000000002 and so on.

Appreciate your help.
Thanks & rgds, Harto

Bob Phillips
07-28-2008, 12:57 AM
Sub GenerateCodeNo()
Dim KeyRange As Range, NewList As Range
Dim ListColCount As Byte, CertNo As Range
Dim CertValue As Double
Dim vPoint As Double, vQty As Long
Dim R As Long, R2 As Long
Dim c As Byte, u As Long, ulang As Long
Dim vE As Double, vH As Double, vI As Double

Sheets(" ").Activate
Set KeyRange = ActiveSheet.Range([A2], [A2].End(xlDown))
Set NewList = KeyRange(KeyRange.Rows.Count + 3, 1)
Set CertNo = ActiveSheet.Range("IT1")
CertValue = CertNo.Value
ListColCount = ActiveSheet.Range([A1], [A1].End(xlToRight)).Columns.Count

ActiveSheet.Range([A1], [A1].End(xlToRight)).Copy
NewList.Offset(-1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.EntireRow.Hidden = False

With NewList.Offset(-1, 22)
.Value = "Certif #"
.Interior.ColorIndex = 15
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With

vQty = 0
vPoint = 0
R2 = 0

For R = 1 To KeyRange.Rows.Count

ulang = KeyRange(R, 14).Value

For u = 1 To ulang

R2 = R2 + 1
For c = 1 To ListColCount

NewList(R2, c) = KeyRange(R, c)
Next c
NewList(R2, 3).NumberFormat = "0"
NewList(R2, 8) = KeyRange(R, 8).Value / KeyRange(R, 14).Value
NewList(R2, 14) = 1
vQty = vQty + NewList(R2, 14).Value
NewList(R2, 15) = KeyRange(R, 15).Value / KeyRange(R, 14).Value
NewList(R2, 15).NumberFormat = "#,##0"
NewList(R2, 15).Copy NewList(R2, 9)
NewList(R2, 5) = NewList(R2, 9) - NewList(R2, 8)
vPoint = vPoint + NewList(R2, 15).Value
vE = vE + NewList(R2, 5)
vH = vH + NewList(R2, 8)
vI = vI + NewList(R2, 9)
NewList(R2, 16).NumberFormat = "dd-mmm-yy"
NewList(R2, 14).NumberFormat = "0"
If CertValue + R2 > 36099999999# Then
CertValue = 36000000000# - R2 + 1
End If
NewList(R2, 23) = CertValue + R2
NewList(R2, 23).NumberFormat = "0"
Next u
Next R

NewList(R2 + 1, 1) = "Total"
NewList(R2 + 1, 5) = FormatNumber(vE, 0)
NewList(R2 + 1, 8) = FormatNumber(vH, 0)
NewList(R2 + 1, 9) = FormatNumber(vI, 0)
NewList(R2 + 1, 13) = FormatNumber(vPoint, 0)
NewList(R2 + 1, 14) = FormatNumber(vQty, 0)
NewList(R2 + 1, 15) = FormatNumber(vPoint, 0)
With NewList(R2 + 1, 1).Resize(1, 23)

.Interior.ColorIndex = 15
.Font.Bold = True
End With

CertNo = NewList(R2, 23)
NewList(-1).Range("V1").Copy Range("W1")
Columns("W:W").ColumnWidth = 14
End Sub

Sub DifRange()
Dim Area As Range, Rangeku As Range

Sheets(" ").Activate
Set Rangeku = ActiveSheet.Range([N2], [N2].End(xlDown))

ActiveWorkbook.Names.Add Name:="Area", RefersTo:=Rangeku

End Sub

slamet Harto
07-28-2008, 01:17 AM
Work well, Thanks Bob.

Realy appreciate it so much.

Best, harto.