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.

 

[offthelip]

what happens when you click OK do you not get the option to debug??

I am totally guessing here but try this:

Sub test2()
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
inarr = Range(Cells(1, 1), Cells(lastrow, 3))
Range(Cells(1, 5), Cells(2 * lastrow, 6)) = ""
outarr = Range(Cells(1, 5), Cells(2 * lastrow, 6))
indi = 0
mon = 0
sumt = 0
For i = 2 To lastrow
If inarr(i, 1) <> "DAILY TOTALS" And inarr(i, 2) <> "" Then
  ' copy the row
  If IsNumeric(inarr(i, 3) Then
  If inarr(i, 3) <> mon Then
    If mon <> 0 Then
      outarr(indi, 1) = "Total"
      outarr(indi, 2) = sumt
      indi = indi + 1
      sumt = 0
    End If
    indi = indi + 1
    outarr(indi, 1) = MonthName(inarr(i, 3)) & "  TOTALS"
    mon = inarr(i, 3)
    indi = indi + 1
  End If
  For j = 1 To 2
   outarr(indi, j) = inarr(i, j)
  Next j
  sumt = sumt + inarr(i, 2)
  indi = indi + 1
End If
End If
Next i
      outarr(indi, 1) = "Total"
      outarr(indi, 2) = sumt
      indi = indi + 1

Range(Cells(1, 5), Cells(2 * lastrow, 6)) = outarr

 

[kelly mort]

There is no debug option when I click on the ok.

and the above code that you provided is giving me the same error

 

[offthelip]

I think you are going to need to debug it: did you try stepping into the subroutine as I suggested in post 9?
Note it works perfectly Ok on my computer, which probably means there is something different about your data compared to what I typed in

 

[offthelip]

another guess change these two lines:

Range(Cells(1, 5), Cells(2 * lastrow, 6)) = ""
outarr = Range(Cells(1, 5), Cells(2 * lastrow, 6))

to

Range(Cells(1, 5), Cells(20 * lastrow, 6)) = ""
outarr = Range(Cells(1, 5), Cells(20 * lastrow, 6))

 

[offthelip]

Hopefully to get your debug working. in the VBA window select tools/options/general/Break on all errors

 

[kelly mort]

another guess change these two lines:

Range(Cells(1, 5), Cells(2 * lastrow, 6)) = ""
outarr = Range(Cells(1, 5), Cells(2 * lastrow, 6))

to

Range(Cells(1, 5), Cells(20 * lastrow, 6)) = ""
outarr = Range(Cells(1, 5), Cells(20 * lastrow, 6))

Okay this code worked. And I think I was calling the macro from the worksheet module that is why it was failing at first.

Now that the code is working very great, please help me fix these:
1. I want to get the code to get the output onto a different sheet.
2. I want to reference my datasheet to a named sheet instead of using the current or active sheet as in your code.
3. I want you to define the various variables used for me (With this I can, but I want to get the most effective variable declaration since you actually understand what each line in the code is doing).


Regards

 

[kelly mort]

See if this OK with you

Sub test()
    Dim myarea, a
    Dim i As Long
    Dim lr As Long
    Set myarea = Range("c5:c" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(2, 1).Areas
    For Each r In myarea
        a = r.Offset(, -2).Resize(r.Count + 1, 3)
        With CreateObject("scripting.dictionary")
            For i = 1 To UBound(a)
                If UCase(a(i, 1)) <> UCase("Daily Total") And a(i, 1) <> "" Then
                    If Not .exists(a(i, 1)) Then
                        .Add a(i, 1), a(i, 2)
                    End If
                End If
            Next
            Set res = Sheets("Sheet2")
            lr = res.Cells(Rows.Count, 5).End(xlUp).Row
            lr = IIf(lr = 1, 1, lr + 2)
            res.Cells(lr, 5) = MonthName(a(1, 3)) & " TOTAL"
            res.Cells(lr + 1, 5).Resize(.Count, 2) = Application.Transpose(Application.Index(Array(.keys, .items), 0, 0))
            res.Cells(lr + .Count + 1, 5) = "TOTAL": res.Cells(lr + .Count + 1, 6) = WorksheetFunction.Sum(.items)
        End With
    Next
End Sub

Hi again,
This is exactly what i get when I run your code.

The first few errors I reported came from my end - I was calling the code from a wrong module.

The output from the above image does not look like the one I am looking for.

I will be very glad if you can fix it for me.
Regards

 

[offthelip]

I have annotated the code with comments to help you understand it, but I haven't declared the varaibles becaus I don't think it helps very much, certainly not as much as writing comments
I have added the references to two different worksheets ( 2 and 3) change them to the names you want.

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
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
      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
    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
  End If
  For j = 1 To 2 ' copy the column A and b to output
   outarr(indi, j) = inarr(i, j) '
  Next j '
  sumt = sumt + inarr(i, 2) ' add the current value to the sum
  indi = indi + 1 ' increment the row
End If
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

there are only two type of variable in this variants and longs, and you can declare them all as variants which is what the default is anyway. They have to be varaints because they are reading or writing to the worksheet. Unfortunately defining something as variant is really missing the point of defining a variable because all it is saying is the varaible can be anything.
If you want to be specifc all the indices are longs everything else is variant

 

[kelly mort]

I used long, variant and then Double for the Sumt and all is good for now.

A few other things:
1. I want start the output data on row 2 instead of row 1 - row 1 will be a header.
2. From the original image I posted, an item appeared only once in a month on the output sheet or data. But your code is repeating them. can you please work around for me? Like having in look like that one at the right? For example since BUILDING/MAINTENANCE appeared twice in January (data sheet), I let it show just once under the output for January and habour the subtotal for the two appearances ; 43 + 32 = 75

 

[kelly mort]

I used long, variant and then Double for the Sumt and all is good for now.

A few other things:
1. I want start the output data on row 2 instead of row 1 - row 1 will be a header.
2. From the original image I posted, an item appeared only once in a month on the output sheet or data. But your code is repeating them. can you please work around for me? Like having in look like that one at the right? For example since BUILDING/MAINTENANCE appeared twice in January (data sheet), I let it show just once under the output for January and habour the subtotal for the two appearances ; 43 + 32 = 75
View attachment 32131

I have been able to figure out how to do the request #1 using this line

indi = 1

Now It is left with the #2