mercmannick
07-11-2005, 01:51 PM
hi peeps
2 of you peeps were kind enough to write a bit of code for me
Sub ToughMacroa()
' Procedure : ToughMacro
' DateTime : 7/8/2005 13:11
' Author :
Application.ScreenUpdating = False
Dim iRow As Long
Dim iLastRow As Long
Dim iSheetCount As Long
Dim iCountCurrentWeek As Long
Dim iCount1to2Week As Long
Dim iCount2to3Week As Long
Dim iCount3toAll As Long
Dim cNotIncluded As Long
Dim rngToSort As Range
iLastRow = Range("B8").End(xlDown).Row
For iRow = iLastRow To 8 Step -1
If Cells(iRow, Asc("O") - 64).Value = "CNF" Or _
Cells(iRow, "B").Value Like "55*" Then
Rows(iRow).Delete
Else
With Cells(iRow, "E")
.Value = DateValue(Replace(.Value, ".", "/"))
If .Value >= Date And .Value <= (Date + 6) Then
iCountCurrentWeek = iCountCurrentWeek + 1 'should be 1 week from today count of rows
ElseIf .Value >= (Date + 7) And .Value <= Date + 13 Then
iCount1to2Week = iCount1to2Week + 1 'should be upto 2 wks from today
ElseIf .Value >= (Date + 14) And .Value <= Date + 20 Then
iCount2to3Week = iCount2to3Week + 1 ' should be upto 3 wks from today
ElseIf .Value >= (Date + 21) Then
iCount3toAll = iCount3toAll + 1 ' should be remaining count
Else
cNotIncluded = cNotIncluded + 1
End If
End With
End If
Next iRow
Range("A1:B5").Activate
Selection.Interior.ColorIndex = 38
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
Columns("A:A").ColumnWidth = 22.71
End With
Range("A1").Value = "Late 1 Week :": Range("B1").Value = iCountCurrentWeek
Range("A2").Value = "Late 2 Weeks :": Range("B2").Value = iCount1to2Week
Range("A3").Value = "Late 3 Weeks : ": Range("B3").Value = iCount2to3Week
Range("A4").Value = "Late 4 Weeks :": Range("B4").Value = iCount3toAll
Range("A5").Value = "CNF & 55 Deleted :": Range("B5").Value = cNotIncluded
MsgBox "Total Count " & vbCrLf & _
"==============================" & vbNewLine & _
"Late 1 Weeks : " & iCountCurrentWeek & vbCrLf & _
"Late 2 Weeks : " & iCount1to2Week & vbCrLf & _
"Late 3 Weeks : " & iCount2to3Week & vbCrLf & _
"Late 4 weeks + " & iCount3toAll & vbNewLine & _
"No CNF Deleted : " & cNotIncluded, , "Weekly Counts Of Late To Finish Date "
Application.ScreenUpdating = True
End Sub
but it seems to count the dates wrongly
can someone point me or show me how this is going wrong
thanks
Merc
2 of you peeps were kind enough to write a bit of code for me
Sub ToughMacroa()
' Procedure : ToughMacro
' DateTime : 7/8/2005 13:11
' Author :
Application.ScreenUpdating = False
Dim iRow As Long
Dim iLastRow As Long
Dim iSheetCount As Long
Dim iCountCurrentWeek As Long
Dim iCount1to2Week As Long
Dim iCount2to3Week As Long
Dim iCount3toAll As Long
Dim cNotIncluded As Long
Dim rngToSort As Range
iLastRow = Range("B8").End(xlDown).Row
For iRow = iLastRow To 8 Step -1
If Cells(iRow, Asc("O") - 64).Value = "CNF" Or _
Cells(iRow, "B").Value Like "55*" Then
Rows(iRow).Delete
Else
With Cells(iRow, "E")
.Value = DateValue(Replace(.Value, ".", "/"))
If .Value >= Date And .Value <= (Date + 6) Then
iCountCurrentWeek = iCountCurrentWeek + 1 'should be 1 week from today count of rows
ElseIf .Value >= (Date + 7) And .Value <= Date + 13 Then
iCount1to2Week = iCount1to2Week + 1 'should be upto 2 wks from today
ElseIf .Value >= (Date + 14) And .Value <= Date + 20 Then
iCount2to3Week = iCount2to3Week + 1 ' should be upto 3 wks from today
ElseIf .Value >= (Date + 21) Then
iCount3toAll = iCount3toAll + 1 ' should be remaining count
Else
cNotIncluded = cNotIncluded + 1
End If
End With
End If
Next iRow
Range("A1:B5").Activate
Selection.Interior.ColorIndex = 38
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
Columns("A:A").ColumnWidth = 22.71
End With
Range("A1").Value = "Late 1 Week :": Range("B1").Value = iCountCurrentWeek
Range("A2").Value = "Late 2 Weeks :": Range("B2").Value = iCount1to2Week
Range("A3").Value = "Late 3 Weeks : ": Range("B3").Value = iCount2to3Week
Range("A4").Value = "Late 4 Weeks :": Range("B4").Value = iCount3toAll
Range("A5").Value = "CNF & 55 Deleted :": Range("B5").Value = cNotIncluded
MsgBox "Total Count " & vbCrLf & _
"==============================" & vbNewLine & _
"Late 1 Weeks : " & iCountCurrentWeek & vbCrLf & _
"Late 2 Weeks : " & iCount1to2Week & vbCrLf & _
"Late 3 Weeks : " & iCount2to3Week & vbCrLf & _
"Late 4 weeks + " & iCount3toAll & vbNewLine & _
"No CNF Deleted : " & cNotIncluded, , "Weekly Counts Of Late To Finish Date "
Application.ScreenUpdating = True
End Sub
but it seems to count the dates wrongly
can someone point me or show me how this is going wrong
thanks
Merc