View Single Post
 
Old 07-02-2015, 02:35 AM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,963
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Try:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim lRow As Long, lCol As Long, i As Long, j As Long, k As Long, l 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
        l = .Range("B" & i + 1).Value
        .Range(.Cells(i + 1, 1), .Cells(i + j, lCol)).Insert Shift:=xlShiftDown
        For k = i + j To i + 1 Step -1
          l = l - 1
          .Range("B" & k).Value = Format(l, "dd-mmm-yyyy")
        Next
      End If
    End If
  Next
  j = Format(.Range("B2").Value, "dd")
  If j > 1 Then
    l = .Range("B" & i + 1).Value
    .Range(.Cells(2, 1), .Cells(j, lCol)).Insert Shift:=xlShiftDown
    For k = j To 2 Step -1
      l = l - 1
      .Range("B" & k).Value = Format(l, "dd-mmm-yyyy")
    Next
  End If
End With
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote