Originally Posted by
mercmannick
help to write this code ............
Hi All
wonder if it is possible to have code to do this
below is a s/sheet i have and i go through 6 diffrent ones each day all the same layout
1 to sort by col o and delete the rows with "cnf"
2 data sort by col B and delete any rows beginning with 55*********
3 replace the . with a / in col e
4 data sort col e
5 to output in a msgbox the following
(all from todays date)
6 count of rows upto 1 week from today
7 count of rows upto 1 - 2 weeks from today
8 count of rows upto 2 - 3 weeks late from today
and the remaining from 3 weeks on to end of list
Regards
Merc
Sample of Sheet below
Dear,
I have created a Macro Procedure.
Just Copy Paste it VBE and Run
Sub ToughMacro()
' Procedure : ToughMacro
' DateTime : 7/8/2005 13:11
' Author : Chandan Banga
' Purpose : Customised Requirements
Dim iRow As Double
Dim iSheetCount As Integer
Dim iCountCurrentWeek As Double
Dim iCount1to2Week As Double
Dim iCount2to3Week As Double
Dim iCount3toAll As Double
Rows("8:8").Select 'Selecting Start Row
Range(Selection, Selection.End(xlDown)).Select 'Selecting Upto n Row
Selection.Sort Key1:=Range("O8"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom 'Sorting Column 0
iRow = 8
While Cells(iRow, 2).Value <> ""
If Cells(iRow, Asc("O") - 64).Value = "CNF" Then
Rows(iRow).Delete
Else
iRow = iRow + 1
End If
Wend
Rows("8:8").Select 'Selecting Start Row
Range(Selection, Selection.End(xlDown)).Select 'Selecting Upto n Row
Selection.Sort Key1:=Range("B8"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom 'Sorting Column 0
iRow = 8
While Cells(iRow, 2).Value <> ""
If Cells(iRow, Asc("B") - 64).Value Like "55*" Then
Rows(iRow).Delete
Else
iRow = iRow + 1
End If
Wend
iRow = 8
While Cells(iRow, 2).Value <> ""
Cells(iRow, Asc("E") - 64).Value = Replace(Cells(iRow, Asc("E") - 64).Value, ".", "/")
iRow = iRow + 1
Wend
Rows("8:8").Select 'Selecting Start Row
Range(Selection, Selection.End(xlDown)).Select 'Selecting Upto n Row
Selection.Sort Key1:=Range("E8"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom 'Sorting Column 0
iRow = 8
While Cells(iRow, Asc("E") - 64).Value <> ""
If CDate(Cells(iRow, Asc("E") - 64).Value) >= Date And CDate(Cells(iRow, Asc("E") - 64).Value) <= (Date + 6) Then
iCountCurrentWeek = iCountCurrentWeek + 1
ElseIf CDate(Cells(iRow, Asc("E") - 64).Value) >= (Date + 7) And CDate(Cells(iRow, Asc("E") - 64).Value) <= Date + 13 Then
iCount1to2Week = iCount1to2Week + 1
ElseIf CDate(Cells(iRow, Asc("E") - 64).Value) >= (Date + 14) And CDate(Cells(iRow, Asc("E") - 64).Value) <= Date + 20 Then
iCount2to3Week = iCount2to3Week + 1
ElseIf CDate(Cells(iRow, Asc("E") - 64).Value) >= (Date + 21) Then
iCount3toAll = iCount3toAll + 1
End If
iRow = iRow + 1
Wend
MsgBox ("Total Count " & vbCrLf & _
"Current Week : " & iCountCurrentWeek & vbCrLf & _
"Next 1 - 2 Week : " & iCount1to2Week & vbCrLf & _
"Next 2 - 3 Week : " & iCount2to3Week & vbCrLf & _
"Next 3 weeks and later : " & iCount3toAll)
End Sub
It is working on the excel sheet what u have provided.
Bye..