how to list missing all date by blank row between change value cells?
- Thread starter poem
- Start date
- Joined
- Dec 16, 2012
- Messages
- 2,327
- Reaction score
- 40
- Points
- 48
- Excel Version(s)
- 365
poem, you have cross posted this at http://www.msofficeforums.com/excel-programming/26877-how-list-missing-all-date-blank-row.html
Cross posting is OK if you tell people everywhere you have cross posted to, at all the sites involved.
Please have a read of http://www.excelguru.ca/content.php?184
Ultimately it's to your benefit.
This time:
Cross posting is OK if you tell people everywhere you have cross posted to, at all the sites involved.
Please have a read of http://www.excelguru.ca/content.php?184
Ultimately it's to your benefit.
This time:
Code:
Sub blah()
For Each are In ActiveSheet.UsedRange.Offset(1).SpecialCells(xlCellTypeConstants, 23).Areas
diff = CLng(Application.WorksheetFunction.EoMonth(are.Rows(are.Rows.Count).Cells(2).Value, 0) - are.Rows(are.Rows.Count).Cells(2).Value)
If diff > 0 Then
are.Rows(are.Rows.Count).Offset(1).Resize(diff).Insert Shift:=xlDown
are.Rows(are.Rows.Count).Resize(, 2).AutoFill Destination:=are.Rows(are.Rows.Count).Resize(diff + 1, 2)
End If
For rw = are.Rows.Count To 1 Step -1
Select Case rw
Case 1
diff = Day(are.Rows(rw).Cells(2).Value)
If diff > 1 Then
are.Rows(rw).Resize(diff - 1).Insert Shift:=xlDown
are.Rows(rw).Resize(, 2).AutoFill Destination:=are.Rows(rw).Offset(1 - diff).Resize(diff, 2), Type:=xlFillDefault
End If
Case Else
diff = are.Rows(rw).Cells(2).Value - are.Rows(rw - 1).Cells(2).Value
If diff > 1 Then
are.Rows(rw).Resize(diff - 1).Insert Shift:=xlDown
are.Rows(rw - 1).Resize(, 2).AutoFill Destination:=are.Rows(rw - 1).Resize(diff, 2), Type:=xlFillDefault
End If
End Select
Next rw
Next are
End Sub