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.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.