how to list missing all date by blank row between change value cells?

poem · #1 06-30-2015, 11:02 PM

i am looking for macro code that isert blank row between data( missing all date) when change value data which each cells are started frist month if not mentied till end of month too

macropod · #2 07-01-2015, 05:48 AM

Try:

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

Cross-posted at: http://www.excelforum.com/excel-prog...lue-cells.html
For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184

poem · #3 07-01-2015, 06:33 AM

thank you too much i appericate .

p45cal · #4 07-01-2015, 06:36 AM

cross post http://www.excelguru.ca/forums/showt...ge-value-cells

poem · #5 07-02-2015, 12:21 AM

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

macropod · #6 07-02-2015, 02:18 AM

poem: Please continue your discussion in your existing thread instead of starting a new one. As it stands, your post here has no context. It would also have been helpful if you'd said you wanted this extra output when you made your initial request - no-one wants to spend time revising their code just because the specifications they were given were incomplete. In some cases, providing incomplete specifications could lead to the code having to be completely re-written.

Also, when posting code, please use the code tags, inserted via the # button on the posting toolbar.

Update: Threads merged.

macropod · #7 07-02-2015, 02:35 AM

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

macropod · #8 07-02-2015, 02:51 AM

poem: I see you have cross-posted again, at:
http://www.excelguru.ca/forums/showt...eature-in-code
and:
http://www.excelforum.com/excel-prog...e-in-code.html
For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184

If you make a habit of cross-posting without providing links, you'll soon find yourself being ignored and, possibly, eventually being banned on various forums... Be assured, I've seen it happen.

poem · #9 07-03-2015, 06:26 AM

Absolutely I never have done it again thanks .
And listened to your advice able

macropod · #10 07-03-2015, 06:36 AM

Please advise the other forums that the problem has been solved, so as to not waste anyone else's time...

poem · #11 07-03-2015, 11:17 AM

okey my dear

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
calculate date if date entered in cell, do nothing if blank	ConfuddledOne	Excel	3	11-07-2014 09:37 AM
Help with Subtotal(103, ) formula and blank cells	zhl203	Excel	1	07-30-2014 03:40 PM
Join cells together separated by ; when some are blank	leemoreau	Excel	3	11-03-2013 11:22 AM
Selecting blank cells in criteria	apolloman	Excel	6	08-24-2011 05:38 AM
Imported message date change to today's date	promark	Outlook	1	12-23-2005 07:21 AM