View Single Post
 
Old 07-02-2015, 12:21 AM
poem poem is offline Windows XP Office 2007
Novice
 
Join Date: Jun 2015
Location: oman
Posts: 13
poem is on a distinguished road
Default add feature in code

could you arrange me feature like
start date for each cell = date serial( 2015,06,01)
end date for each cell =date serial (2015,06,30)
note if frist date not mentiond ( 2015,06,01) insert blank row
and insert blank row till end date (2015,06,30)
add in this code

Sub Demo()
Application.ScreenUpdating = False
Dim lRow As Long, lCol As Long, i As Long, j As Long
With ActiveWorkbook.ActiveSheet.UsedRange
lRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
lCol = .Cells.SpecialCells(xlCellTypeLastCell).Column
For i = lRow - 1 To 2 Step -1
If .Range("B" & i + 1).Value = 0 Then
ElseIf .Range("B" & i).Value = 0 Then
Else
j = .Range("B" & i + 1).Value - .Range("B" & i).Value - 1
If j > 0 Then
.Range(.Cells(i + 1, 1), .Cells(i + j, lCol)).Insert Shift:=xlShiftDown
End If
End If
Next
j = Format(.Range("B2").Value, "dd")
If j > 1 Then
.Range(.Cells(2, 1), .Cells(j, lCol)).Insert Shift:=xlShiftDown
End If
End With
Application.ScreenUpdating = True
End Sub
Attached Files
File Type: xlsx sheet 2 .xlsx (144.8 KB, 10 views)
Reply With Quote