How To Add Range Of Data With Dynamic Criteria With VBA Onto A Different Sheet

[kelly mort]

From the image below, I want to achieve any of the filtered data at the right depending on which month I reference.

I am thinking of copying all data for 1s under the column C (month)
Then I delete all date rows (from col A) from the copied data.
After that, I will also delete all DAILY TOTALS rows (Under col A) from the copied data.

Once I am done with the above deletions, my copied data should contain just the items or products.
My next move would be to remove duplicates so that no item appears more than once in the copied data.

From here, using a sumif function against the range the data was copied from used get me result.

But my issue here is that I don't know how to start writing the script to point me to the right direction.

Can someone please help me out? I have tried all what I can but I can't seem to figure out the way out yet.

Ps: I want the output to be on a different sheet.

Thanks in advance.

 

[kelly mort]

Very sorry my mistake I put the if statement in the wrong place:try this:

Sub test2()
With Worksheets("Sheet2") ' input sheet
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row ' find last row of col A
inarr = .Range(.Cells(1, 1), .Cells(lastrow, 3)) ' load coluimns A , b and C into varaint array
End With
With Worksheets("Sheet3") ' swap to output sheet
.Range(.Cells(1, 5), .Cells(20 * lastrow, 6)) = "" ' clear the output range
outarr = .Range(.Cells(1, 5), .Cells(20 * lastrow, 6)) ' load the output array from the worksheet ensur it is all clear
indi = 0 ' set outpt index to zero
mon = 0 ' set month number to zero
sumt = 0 ' set monthly sum to zero
monstart = 2
For i = 2 To lastrow ' loop through all the input rows
If inarr(i, 1) <> "DAILY TOTALS" And inarr(i, 2) <> "" Then ' check if it is arow we don't copy
  ' copy the row
  If IsNumeric(inarr(i, 3)) Then ' check if the month numberr is numeric
    If inarr(i, 3) <> mon Then ' check if we have got to the next month
      If mon <> 0 Then ' check if we have process one month , if we have put in the totals
      If mon = 2 Then
        outarr(indi, 1) = "Total"  ' add text to output row
        outarr(indi, 2) = sumt     ' add total to output row
        indi = indi + 1 ' skip a row
        sumt = 0        ' reset the sum to zero
      End If
      End If
      indi = indi + 1  ' increment the output row count
    
      outarr(indi, 1) = MonthName(mon) & "  TOTALS" ' output month name and text to next row
      mon = inarr(i, 3) ' set the current month to the new month
      indi = indi + 1 ' increment the output row
      modstart = indi
    End If
    addto = False
    For kk = monstart To indi
     If inarr(i, 1) = outarr(kk, 1) Then
       outarr(kk, 2) = outarr(kk, 2) + inarr(i, 2)
       addto = True
       Exit For
     End If
    Next kk
     If Not (addto) Then
     For j = 1 To 2 ' copy the column A and b to output
     outarr(indi, j) = inarr(i, j)
     Next j '
     indi = indi + 1 ' increment the row
    End If
   sumt = sumt + inarr(i, 2) ' add the current value to the sum

  End If
End If
Next i
      If mon = 2 Then
      outarr(indi, 1) = "Total"  ' put int the totals for the last month
      outarr(indi, 2) = sumt '
      indi = indi + 1 ' increment the row count  actually I don't think we need this!!
      End If
.Range(.Cells(1, 1), .Cells(2 * lastrow, 2)) = outarr 'output the array to the workhseet
End With
End Sub

I get the error :
Invalid procedure call or argument

 

[offthelip]

Try this one, I have actaully tested this version so hopefully it will work for you to.

Sub test2()
With Worksheets("Sheet2") ' input sheet
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row ' find last row of col A
inarr = .Range(.Cells(1, 1), .Cells(lastrow, 3)) ' load coluimns A , b and C into varaint array
End With
With Worksheets("Sheet3") ' swap to output sheet
.Range(.Cells(1, 5), .Cells(20 * lastrow, 6)) = "" ' clear the output range
outarr = .Range(.Cells(1, 5), .Cells(20 * lastrow, 6)) ' load the output array from the worksheet ensur it is all clear
indi = 0 ' set outpt index to zero
mon = 0 ' set month number to zero
sumt = 0 ' set monthly sum to zero
monstart = 2
For i = 2 To lastrow ' loop through all the input rows
 If inarr(i, 1) <> "DAILY TOTALS" And inarr(i, 2) <> "" Then ' check if it is arow we don't copy
  ' copy the row
  If IsNumeric(inarr(i, 3)) Then ' check if the month numberr is numeric
    If inarr(i, 3) <> mon Then ' check if we have got to the next month
      If mon <> 0 Then ' check if we have process one month , if we have put in the totals
      If mon = 2 Then
        outarr(indi, 1) = "Total"  ' add text to output row
        outarr(indi, 2) = sumt     ' add total to output row
        indi = indi + 1 ' skip a row
      End If
        sumt = 0        ' reset the sum to zero
      End If
      indi = indi + 1  ' increment the output row count
      
      outarr(indi, 1) = MonthName(inarr(i, 3)) & "  TOTALS" ' output month name and text to next row
      mon = inarr(i, 3) ' set the current month to the new month
      indi = indi + 1 ' increment the output row
      monstart = indi
    End If
    addto = False
    For kk = monstart To indi
     If inarr(i, 1) = outarr(kk, 1) Then
       outarr(kk, 2) = outarr(kk, 2) + inarr(i, 2)
       addto = True
       Exit For
     End If
    Next kk
     If Not (addto) Then
     For j = 1 To 2 ' copy the column A and b to output
     outarr(indi, j) = inarr(i, j)
     Next j '
     indi = indi + 1 ' increment the row
    End If
   sumt = sumt + inarr(i, 2) ' add the current value to the sum
  
  End If
 End If
Next i
      If mon = 2 Then
      outarr(indi, 1) = "Total"  ' put int the totals for the last month
      outarr(indi, 2) = sumt '
      indi = indi + 1 ' increment the row count  actually I don't think we need this!!
      End If
.Range(.Cells(1, 1), .Cells(2 * lastrow, 2)) = outarr 'output the array to the workhseet
End With
End Sub

 

[kelly mort]

Wow!!!!!!
You are very great.

Now all the bugs are handled. The only thing left is that I think I failed to express myself properly when I said the Monthly totals for February only.

This is exactly what I wanted to achieve:

I want to have only the records for February onto the output sheet as above.

 

[offthelip]

Is the requirement that you want february totals only, going to change. i.e do you want to be able to select which month you want total for? I ask because it is very unusual to just want february data in June!!

 

[kelly mort]

Is the requirement that you want february totals only, going to change. i.e do you want to be able to select which month you want total for? I ask because it is very unusual to just want february data in June!!

I will be switching the various months (meaning that the requirement will sure change overtime) . But I think I could handle that part of the logic.

I can use inputbox to accept the month to get its total or maybe a combobox to do the feeding.

But I am sure you might have a better way to go about things.

 

[offthelip]

picking out one specifc month is actually a lot simpler than what you orignally specified. What this does show is that it is really worth thinking very carefully about what your actual requirements are,
try this code:

Sub test3()
With Worksheets("Sheet2") ' input sheet
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row ' find last row of col A
inarr = .Range(.Cells(1, 1), .Cells(lastrow, 3)) ' load coluimns A , b and C into varaint array
End With
With Worksheets("Sheet3") ' swap to output sheet
.Range(.Cells(1, 5), .Cells(20 * lastrow, 6)) = "" ' clear the output range
outarr = .Range(.Cells(1, 5), .Cells(20 * lastrow, 6)) ' load the output array from the worksheet ensur it is all clear
indi = 0 ' set outpt index to zero
'mon = 0 ' set month number to zero
mon = Application.InputBox(prompt:="Enter Month Number ", Type:=1)
sumt = 0 ' set monthly sum to zero
monstart = 2
outarr(1, 1) = MonthName(mon) & "  TOTALS" ' output month name and text to next row
indi = 2 ' increment the output row

For i = 2 To lastrow ' loop through all the input rows
 If inarr(i, 1) <> "DAILY TOTALS" And inarr(i, 2) <> "" And inarr(i, 3) = mon Then ' check if it is arow we don't copy
  ' copy the row
    addto = False
    For kk = monstart To indi
     If inarr(i, 1) = outarr(kk, 1) Then
       outarr(kk, 2) = outarr(kk, 2) + inarr(i, 2)
       addto = True
       Exit For
     End If
    Next kk
     If Not (addto) Then
        For j = 1 To 2 ' copy the column A and b to output
        outarr(indi, j) = inarr(i, j)
        Next j '
     indi = indi + 1 ' increment the row
    End If
   sumt = sumt + inarr(i, 2) ' add the current value to the sum
  
  End If
 
Next i
      
      outarr(indi, 1) = "Total"  ' put int the totals for the last month
      outarr(indi, 2) = sumt '
      indi = indi + 1 ' increment the row count  actually I don't think we need this!!
      .Range(.Cells(1, 1), .Cells(2 * lastrow, 2)) = outarr 'output the array to the workhseet
End With
End Sub

 

[kelly mort]

hello again @offthelip

I needed the solution for both multiple months and single month. I will be doing so at different times. There could be a time that I would want to get just a single month, times that I might want to show all months, various quarters and so on.

Which means that your code in post #32 is very useful to me just as the recent one in post #36 (for single month).

The post #36 handled the single month perfectly and I am impressed and very grateful.

However, from the post #32, I tried making these tweaks:

Select Case mon
     Case 1, 3
      outarr(indi, 1) = "Total"  ' add text to output row
      outarr(indi, 2) = sumt     ' add total to output row
      indi = indi + 1 ' skip a row
  Case Else
End Select

Select Case mon
            Case 1, 3
                outarr(indi, 1) = "Total"  ' put int the totals for the last month
                outarr(indi, 2) = sumt '
                indi = indi + 1 ' increment the row count  actually I don't think we need this!!
            Case Else
        End Select

Against the database below:

That tweak in the code gave me this, which made me very happy as it was pointing me to a right direction:

Since I used the switches, 1 and 3 in the case statement, I was expecting to see only the displays for January and March.

So, focusing on the code from post #32, if I get only the output for the month selection by the case statement switch as above, avoiding all other months that are not included in the selection, I will be very happy.

Do not worry about how the data (month selection) will be fed into the code - I will be able to handle that part of the logic as I pointed out in an earlier post.

So from the example above, referencing from the db sample added, since there are just 3 months available, the goal is to display only those specified (Jan & Mar) while discarding the others (Feb).

It feels like I am demanding too much but this would be the last request once it is fixed.

Thanks so much for your patience.

 

[offthelip]

I have added a do loop round the single month version which will run it again and again for as many months as you want. try this:

Sub test3()
With Worksheets("Sheet2") ' input sheet
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row ' find last row of col A
inarr = .Range(.Cells(1, 1), .Cells(lastrow, 3)) ' load coluimns A , b and C into varaint array
End With
With Worksheets("Sheet3") ' swap to output sheet
.Range(.Cells(1, 5), .Cells(20 * lastrow, 6)) = "" ' clear the output range
outarr = .Range(.Cells(1, 5), .Cells(20 * lastrow, 6)) ' load the output array from the worksheet ensur it is all clear
indi = 1 ' increment the output row

Do
mon = Application.InputBox(prompt:="Enter Month Number ", Type:=1)
sumt = 0 ' set monthly sum to zero

outarr(indi, 1) = MonthName(mon) & "  TOTALS" ' output month name and text to next row
indi = indi + 1
monstart = indi
For i = 2 To lastrow ' loop through all the input rows
 If inarr(i, 1) <> "DAILY TOTALS" And inarr(i, 2) <> "" And inarr(i, 3) = mon Then ' check if it is arow we don't copy
  ' copy the row
    addto = False
    For kk = monstart To indi
     If inarr(i, 1) = outarr(kk, 1) Then
       outarr(kk, 2) = outarr(kk, 2) + inarr(i, 2)
       addto = True
       Exit For
     End If
    Next kk
     If Not (addto) Then
        For j = 1 To 2 ' copy the column A and b to output
        outarr(indi, j) = inarr(i, j)
        Next j '
     indi = indi + 1 ' increment the row
    End If
   sumt = sumt + inarr(i, 2) ' add the current value to the sum
  
  End If
 
Next i
      
      outarr(indi, 1) = "Total"  ' put int the totals for the last month
      outarr(indi, 2) = sumt '
      indi = indi + 2 ' increment the row count  actually I don't think we need this!!
      .Range(.Cells(1, 1), .Cells(2 * lastrow, 2)) = outarr 'output the array to the workhseet
 contin = MsgBox("Do you want to include another month?", 4)
 Loop Until contin <> 6

End With
End Sub

 

[kelly mort]

All set!!!
Thanks again. I am very grateful. I have really learned a great deal from your skills.

Have a very wonderful time.