Copy Data by month to table using Inputbox with Add or Delete Row

Hello. I show you a way to do it from a "model" range:

PHP Code: 

Sub Traspasar_Info()
Dim a, Q&, i&, D, key$, mCell As Range, R&, tbl
Dim mMin As Date, mMax As Date, f As Date

With Sheet1
  If .Cells(4, "b") = "" Then End
  
  With .Range("b4", .Range("b3").End(xlDown))
    mMin = Application.Min(.Cells): mMin = mMin - Day(mMin) + 1
    mMax = Application.Max(.Cells): mMax = mMax - Day(mMax) + 1
    a = .Resize(, 3).Value: Q = UBound(a)
  End With
  Set D = CreateObject("Scripting.Dictionary")
  
  For i = 1 To Q
    key = Format(a(i, 1), "mm_yyyy")
    If D.Exists(key) Then
      R = 1 + D(key)(0): tbl = D(key)(1)
      tbl(R, 1) = a(i, 1): tbl(R, 2) = a(i, 2): tbl(R, 3) = a(i, 3)
      D(key) = Array(R, tbl)
    Else
      ReDim tbl(1 To Q, 1 To 3)
      tbl(1, 1) = a(i, 1): tbl(1, 2) = a(i, 2): tbl(1, 3) = a(i, 3)
      D(key) = Array(1, tbl)
    End If
  Next
End With

With Sheet2
  .Rows("1:4").Hidden = True
  .Range("f7", .Cells(Rows.Count, "f").End(xlUp)).Offset(1, -1).Resize(, 7).Delete xlShiftUp
  
  f = mMin
  Do
    key = Format(f, "mm_yyyy")
    If D.Exists(key) Then
      Set mCell = .Cells(Rows.Count, "f").End(xlUp).Offset(2, -1)
      Range("Diff_Model").Copy mCell
      mCell.Offset(2).Range("a1:g" & D(key)(0) - 1).Insert xlShiftDown
      mCell = f
      mCell(2).Resize(D(key)(0), 3) = D(key)(1)
    End If
    f = DateAdd("m", 1, f)
  Loop While f <= mMax
  .Activate
End With
End Sub 


First of all Thank you very much for your effort.

Second thing is I didn't understand code.

It's working, but sometime giving Error in this line.

Please Login or Register  to view this content.

and where to add other months? I have tried to add but not working.

Thanks.

You are right. Then:

PHP Code: 

Rem >Replaces:
  mCell.Offset(2).Range("a1:g" & D(key)(0) - 1).Insert xlShiftDown

Rem >for this other:
  If D(key)(0) > 1 Then mCell.Offset(2).Range("a1:g" & D(key)(0) - 1).Insert xlShiftDown 


The variant I am attaching now may be better understood by you because it does the same thing as the previous variant but without using a Dictionary.

Hi beyond Excel,

it seems solved on another forum …

Originally Posted by Marc L

Hi beyond Excel,

it seems solved on another forum …

Too bad!... (for the lack of gratitude).

Hi Beyond Excel,

Thank you for your efforts and Sorry for the late reply.

Code Working as require, but the thing is, It is creating Tables in new sheet. But I have already created Blanks Table in Sheet2 (Diff Sheet). So If there is no data in any month then it will keep it blank (it is ok if It'll create Table in Sheet2, but need to also create blank if no any data in particular month). So if possible that way? And also month will start from April ('cause we are counting year from April to March).

Thank You Very Much.

In this Forum it is customary to thank the help received by adding reputation (click on *) at the bottom right of the messages that have helped you solve your problem.