Results 1 to 3 of 3

Thread: add feature in code

  1. #1

    add feature in code



    Register for a FREE account, and/
    or Log in to avoid these ads!

    couldyou arrange me feature like
    startdate for each cell = date serial( 2015,06,01)
    enddate for each cell =date serial (2015,06,30)
    noteif frist date not mentiond ( 2015,06,01) insert blank row
    andinsert blank row till end date (2015,06,30)
    addin this code
    1. Subblah()
    2. ForEach are In ActiveSheet.UsedRange.Offset(1).SpecialCells(xlCellTypeConstants,23).Areas
    3. diff =CLng(Application.WorksheetFunction.EoMonth(are.Rows(are.Rows.Count).Cells(2).Value,0) - are.Rows(are.Rows.Count).Cells(2).Value)
    4. If diff > 0 Then
    5. are.Rows(are.Rows.Count).Offset(1).Resize(diff).InsertShift:=xlDown
    6. are.Rows(are.Rows.Count).Resize(,2).AutoFill Destination:=are.Rows(are.Rows.Count).Resize(diff + 1, 2)
    7. End If
    8. For rw = are.Rows.Count To 1 Step -1
    9. Select Case rw
    10. Case 1
    11. diff = Day(are.Rows(rw).Cells(2).Value)
    12. If diff > 1 Then
    13. are.Rows(rw).Resize(diff - 1).InsertShift:=xlDown
    14. are.Rows(rw).Resize(, 2).AutoFillDestination:=are.Rows(rw).Offset(1 - diff).Resize(diff, 2), Type:=xlFillDefault
    15. End If
    16. Case Else
    17. diff = are.Rows(rw).Cells(2).Value -are.Rows(rw - 1).Cells(2).Value
    18. If diff > 1 Then
    19. are.Rows(rw).Resize(diff - 1).InsertShift:=xlDown
    20. are.Rows(rw - 1).Resize(, 2).AutoFillDestination:=are.Rows(rw - 1).Resize(diff, 2), Type:=xlFillDefault
    21. End If
    22. End Select
    23. Next rw
    24. Nextare
    End Sub
    Attached Files Attached Files

  2. #2
    thank you too much for solving i appericate you

  3. #3
    i found solution .

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •