ExcelBanter - Bottom Up search for multiple entries

Page 1 of 2

Show 40 post(s) from this thread on one page

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - Bottom Up search for multiple entries (https://www.excelbanter.com/excel-programming/447346-bottom-up-search-multiple-entries.html)

Hans Hamm

Bottom Up search for multiple entries

I have not done this in a long time and cannot remember how...
Want to look in sheet 3, row D... bottom up
find each Program entry (there can be 10+ entries for the same program)
Then copy those entries (program names) and past into sheet 2 starting with cell A5.
Just cannot remember how to do it

Ben McClave

Bottom Up search for multiple entries

Hans,

I wrote a short macro to copy your data range to a blank column in your workbook and then use RemoveDuplicates to speed up the process. This new range of unique values is then cycled through in reverse to populate your destination list. Finally, the temporary column we added is cleared.

Hope this helps,

Ben

Sub ListPrograms()
Dim rCopy As Range 'Range of values to check
Dim rCopy2 As Range 'Blank cell at the top of an unused column
Dim x As Long 'Used for cycling through the rCopy2 range
Dim y As Long 'Used for cycling through the rPaste range
Dim rPaste As Range 'First cell to receive the data

'First, set up the copy from range and the copy/paste to range
'Application.ScreenUpdating = False 'Uncomment this line if macro runs slow

Set rCopy = Sheet3.Range("D1:D" & Sheet1.Range("D64000").End(xlUp).Row)
Set rCopy2 = Sheet1.Range("E1") 'Empty column somewhere in your workbook
Set rPaste = Sheet2.Range("A5")

y = 0 'Set to zero to start

'Next, resize the rCopy2 range to match the rCopy range size and copy the data
Set rCopy2 = rCopy2.Resize(rCopy.Rows.Count, 1)
rCopy.Copy rCopy2

'Now, remove duplicates (assumes no headers)
rCopy2.RemoveDuplicates 1, xlNo

'Once again resize rCopy2 to cover reduced data range
'**(Check next line to ensure that the sheet name and column are correct)
Set rCopy2 = Sheet1.Range("E1:E" & Sheet1.Range("E64000").End(xlUp).Row)

'Now, cycle through each value in rCopy2 starting from the bottom _
and paste it to the final destination.
For x = rCopy2.Rows.Count To 1 Step -1
rPaste.Offset(y, 0).Value = rCopy2.Cells(x, 1)
y = y + 1 'Increment y to ensure next value goes into the cell below
Next x

'Finally, clear the rCopy2 range as it is no longer necessary.
rCopy2.Clear
Application.ScreenUpdating = True

End Sub

Hans Hamm

Bottom Up search for multiple entries

On Wednesday, October 10, 2012 5:53:23 PM UTC-4, Ben McClave wrote:
Hans,

I wrote a short macro to copy your data range to a blank column in your workbook and then use RemoveDuplicates to speed up the process. This new range of unique values is then cycled through in reverse to populate your destination list. Finally, the temporary column we added is cleared.

Hope this helps,

Ben

Sub ListPrograms()

Dim rCopy As Range 'Range of values to check

Dim rCopy2 As Range 'Blank cell at the top of an unused column

Dim x As Long 'Used for cycling through the rCopy2 range

Dim y As Long 'Used for cycling through the rPaste range

Dim rPaste As Range 'First cell to receive the data

'First, set up the copy from range and the copy/paste to range

'Application.ScreenUpdating = False 'Uncomment this line if macro runs slow

Set rCopy = Sheet3.Range("D1:D" & Sheet1.Range("D64000").End(xlUp).Row)

Set rCopy2 = Sheet1.Range("E1") 'Empty column somewhere in your workbook

Set rPaste = Sheet2.Range("A5")

y = 0 'Set to zero to start

'Next, resize the rCopy2 range to match the rCopy range size and copy the data

Set rCopy2 = rCopy2.Resize(rCopy.Rows.Count, 1)

rCopy.Copy rCopy2

'Now, remove duplicates (assumes no headers)

rCopy2.RemoveDuplicates 1, xlNo

'Once again resize rCopy2 to cover reduced data range

'**(Check next line to ensure that the sheet name and column are correct)

Set rCopy2 = Sheet1.Range("E1:E" & Sheet1.Range("E64000").End(xlUp)..Row)

'Now, cycle through each value in rCopy2 starting from the bottom _

and paste it to the final destination.

For x = rCopy2.Rows.Count To 1 Step -1

rPaste.Offset(y, 0).Value = rCopy2.Cells(x, 1)

y = y + 1 'Increment y to ensure next value goes into the cell below

Next x

'Finally, clear the rCopy2 range as it is no longer necessary.

rCopy2.Clear

Application.ScreenUpdating = True

End Sub

Ben, Cool...one little tweek and it worked DEAD ON!Had to change "Sheet3.Range("D1:D...." to D2 as I have headers.Thanks for the help. I have not done any of this in 8-9 years and just cannot remember any of it. So I may be reaching out again for some assistance.

Ben McClave

Bottom Up search for multiple entries

Hans,

I'm glad to hear that it worked for you. Thanks for the feedback.

Ben

Claus Busch

Bottom Up search for multiple entries

Hi Hans,

Am Wed, 10 Oct 2012 07:37:42 -0700 (PDT) schrieb Hans Hamm:

Want to look in sheet 3, row D... bottom up
find each Program entry (there can be 10+ entries for the same program)
Then copy those entries (program names) and past into sheet 2 starting with cell A5.

try:
Sheets("Sheet3").Columns("D:D").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Sheet2").Range("A5"), Unique:=True

Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Hans Hamm

Bottom Up search for multiple entries

On Thursday, October 11, 2012 1:12:23 PM UTC-4, Ben McClave wrote:
Hans,

I'm glad to hear that it worked for you. Thanks for the feedback.

Ben

Now have an additional one for you....
You provided this code:
Set rPaste = Sheet2.Range("A5")

I have found I need the same information in an additional location, specifically Sheet2 starting in cell A36.
Tried three different ways
Set rPaste2 = Sheet2.Range("A36")
Set rPaste = Sheet2.Range("A5")&("A36")
Set rPaste = Sheet2.Range("A5", "A36")
Neither works... how would I do this?

Ben McClave

Bottom Up search for multiple entries

Hans,

I've modified this a bit to do this for you. Please note I haven't tested it. Let me know if you have any issues with it.

Ben

Sub ListPrograms()
Dim rCopy As Range 'Range of values to check
Dim rCopy2 As Range 'Blank cell at the top of an unused column
Dim x As Long 'Used for cycling through the rCopy2 range
Dim y As Long 'Used for cycling through the rPaste range
Dim rPaste(1 to 2) As Range 'First cell to receive the data

'First, set up the copy from range and the copy/paste to range
'Application.ScreenUpdating = False 'Uncomment this line if macro runs slow

Set rCopy = Sheet3.Range("D2:D" & Sheet1.Range("D64000").End(xlUp).Row)
Set rCopy2 = Sheet1.Range("E1") 'Empty column somewhere in your workbook
Set rPaste(1) = Sheet2.Range("A5")
Set rPaste(2) = Sheet2.Range("A36")

y = 0 'Set to zero to start

'Next, resize the rCopy2 range to match the rCopy range size and copy the data
Set rCopy2 = rCopy2.Resize(rCopy.Rows.Count, 1)
rCopy.Copy rCopy2

'Now, remove duplicates (assumes no headers)
rCopy2.RemoveDuplicates 1, xlNo

'Once again resize rCopy2 to cover reduced data range
'**(Check next line to ensure that the sheet name and column are correct)
Set rCopy2 = Sheet1.Range("E1:E" & Sheet1.Range("E64000").End(xlUp).Row)

'Now, cycle through each value in rCopy2 starting from the bottom _
and paste it to the final destination.
For x = rCopy2.Rows.Count To 1 Step -1
rPaste(1).Offset(y, 0).Value = rCopy2.Cells(x, 1)
rPaste(2).Offset(y, 0).Value = rCopy2.Cells(x, 1)
y = y + 1 'Increment y to ensure next value goes into the cell below
Next x

'Finally, clear the rCopy2 range as it is no longer necessary.
rCopy2.Clear
Application.ScreenUpdating = True

End Sub

Hans Hamm

Bottom Up search for multiple entries

On Friday, October 12, 2012 6:42:15 PM UTC-4, Ben McClave wrote:
Hans,

I've modified this a bit to do this for you. Please note I haven't tested it. Let me know if you have any issues with it.

Ben

Sub ListPrograms()

Dim rCopy As Range 'Range of values to check

Dim rCopy2 As Range 'Blank cell at the top of an unused column

Dim x As Long 'Used for cycling through the rCopy2 range

Dim y As Long 'Used for cycling through the rPaste range

Dim rPaste(1 to 2) As Range 'First cell to receive the data

'First, set up the copy from range and the copy/paste to range

'Application.ScreenUpdating = False 'Uncomment this line if macro runs slow

Set rCopy = Sheet3.Range("D2:D" & Sheet1.Range("D64000").End(xlUp).Row)

Set rCopy2 = Sheet1.Range("E1") 'Empty column somewhere in your workbook

Set rPaste(1) = Sheet2.Range("A5")

Set rPaste(2) = Sheet2.Range("A36")

y = 0 'Set to zero to start

'Next, resize the rCopy2 range to match the rCopy range size and copy the data

Set rCopy2 = rCopy2.Resize(rCopy.Rows.Count, 1)

rCopy.Copy rCopy2

'Now, remove duplicates (assumes no headers)

rCopy2.RemoveDuplicates 1, xlNo

'Once again resize rCopy2 to cover reduced data range

'**(Check next line to ensure that the sheet name and column are correct)

Set rCopy2 = Sheet1.Range("E1:E" & Sheet1.Range("E64000").End(xlUp).Row)

'Now, cycle through each value in rCopy2 starting from the bottom _

and paste it to the final destination.

For x = rCopy2.Rows.Count To 1 Step -1

rPaste(1).Offset(y, 0).Value = rCopy2.Cells(x, 1)

rPaste(2).Offset(y, 0).Value = rCopy2.Cells(x, 1)

y = y + 1 'Increment y to ensure next value goes into the cell below

Next x

'Finally, clear the rCopy2 range as it is no longer necessary.

rCopy2.Clear

Application.ScreenUpdating = True

End Sub

Ah Ha! So, that is how you repeat a process with "Dim rPaste(1 To 2)" I could not figure out how to do that without repeating the entire process. Thanks! I am sure I will have additional questions for you when I hit the "wall" I do appreciate your help.

Hans Hamm

Bottom Up search for multiple entries

On Monday, October 15, 2012 7:43:16 AM UTC-4, Hans Hamm wrote:
On Friday, October 12, 2012 6:42:15 PM UTC-4, Ben McClave wrote:

Hans,

I've modified this a bit to do this for you. Please note I haven't tested it. Let me know if you have any issues with it.

Ben

Sub ListPrograms()

Dim rCopy As Range 'Range of values to check

Dim rCopy2 As Range 'Blank cell at the top of an unused column

Dim x As Long 'Used for cycling through the rCopy2 range

Dim y As Long 'Used for cycling through the rPaste range

Dim rPaste(1 to 2) As Range 'First cell to receive the data

'First, set up the copy from range and the copy/paste to range

'Application.ScreenUpdating = False 'Uncomment this line if macro runs slow

Set rCopy = Sheet3.Range("D2:D" & Sheet1.Range("D64000").End(xlUp).Row)

Set rCopy2 = Sheet1.Range("E1") 'Empty column somewhere in your workbook

Set rPaste(1) = Sheet2.Range("A5")

Set rPaste(2) = Sheet2.Range("A36")

y = 0 'Set to zero to start

'Next, resize the rCopy2 range to match the rCopy range size and copy the data

Set rCopy2 = rCopy2.Resize(rCopy.Rows.Count, 1)

rCopy.Copy rCopy2

'Now, remove duplicates (assumes no headers)

rCopy2.RemoveDuplicates 1, xlNo

'Once again resize rCopy2 to cover reduced data range

'**(Check next line to ensure that the sheet name and column are correct)

Set rCopy2 = Sheet1.Range("E1:E" & Sheet1.Range("E64000").End(xlUp).Row)

'Now, cycle through each value in rCopy2 starting from the bottom _

and paste it to the final destination.

For x = rCopy2.Rows.Count To 1 Step -1

rPaste(1).Offset(y, 0).Value = rCopy2.Cells(x, 1)

rPaste(2).Offset(y, 0).Value = rCopy2.Cells(x, 1)

y = y + 1 'Increment y to ensure next value goes into the cell below

Next x

'Finally, clear the rCopy2 range as it is no longer necessary.

rCopy2.Clear

Application.ScreenUpdating = True

End Sub

Ah Ha! So, that is how you repeat a process with "Dim rPaste(1 To 2)" I could not figure out how to do that without repeating the entire process. Thanks! I am sure I will have additional questions for you when I hit the "wall" I do appreciate your help.

Ben, don't know if you are still seeing this, but I have a question for you.. I am using (adapted a little) the code you provided in a different workbook and repeating the same process over and again looking for different information and it works to perfection! At the end of each section of code I need it to skip 2 rows and repeat the process (looking for different information from another column) How do I make this work?

Hans Hamm

Bottom Up search for multiple entries

On Tuesday, October 30, 2012 9:07:59 AM UTC-4, Hans Hamm wrote:
On Monday, October 15, 2012 7:43:16 AM UTC-4, Hans Hamm wrote:

On Friday, October 12, 2012 6:42:15 PM UTC-4, Ben McClave wrote:

Hans,

I've modified this a bit to do this for you. Please note I haven't tested it. Let me know if you have any issues with it.

Ben

Sub ListPrograms()

Dim rCopy As Range 'Range of values to check

Dim rCopy2 As Range 'Blank cell at the top of an unused column

Dim x As Long 'Used for cycling through the rCopy2 range

Dim y As Long 'Used for cycling through the rPaste range

Dim rPaste(1 to 2) As Range 'First cell to receive the data

'First, set up the copy from range and the copy/paste to range

'Application.ScreenUpdating = False 'Uncomment this line if macro runs slow

Set rCopy = Sheet3.Range("D2:D" & Sheet1.Range("D64000").End(xlUp).Row)

Set rCopy2 = Sheet1.Range("E1") 'Empty column somewhere in your workbook

Set rPaste(1) = Sheet2.Range("A5")

Set rPaste(2) = Sheet2.Range("A36")

y = 0 'Set to zero to start

'Next, resize the rCopy2 range to match the rCopy range size and copy the data

Set rCopy2 = rCopy2.Resize(rCopy.Rows.Count, 1)

rCopy.Copy rCopy2

'Now, remove duplicates (assumes no headers)

rCopy2.RemoveDuplicates 1, xlNo

'Once again resize rCopy2 to cover reduced data range

'**(Check next line to ensure that the sheet name and column are correct)

Set rCopy2 = Sheet1.Range("E1:E" & Sheet1.Range("E64000").End(xlUp).Row)

'Now, cycle through each value in rCopy2 starting from the bottom _

and paste it to the final destination.

For x = rCopy2.Rows.Count To 1 Step -1

rPaste(1).Offset(y, 0).Value = rCopy2.Cells(x, 1)

rPaste(2).Offset(y, 0).Value = rCopy2.Cells(x, 1)

y = y + 1 'Increment y to ensure next value goes into the cell below

Next x

'Finally, clear the rCopy2 range as it is no longer necessary.

rCopy2.Clear

Application.ScreenUpdating = True

End Sub

Ah Ha! So, that is how you repeat a process with "Dim rPaste(1 To 2)" I could not figure out how to do that without repeating the entire process. Thanks! I am sure I will have additional questions for you when I hit the "wall" I do appreciate your help.

Ben, don't know if you are still seeing this, but I have a question for you. I am using (adapted a little) the code you provided in a different workbook and repeating the same process over and again looking for different information and it works to perfection! At the end of each section of code I need it to skip 2 rows and repeat the process (looking for different information from another column) How do I make this work?

I should have added; while most everything is working I am now trying to clean it up and automate more...

Ben McClave

Bottom Up search for multiple entries

Hans,

I'm having trouble picturing what you would like to change. Would you mind posting the code you're using and insert comments where you would like the changes to occur?

As I understand it, the code currently cycles through each unique value in column D and pastes them in reverse order to two separate places. When you say "skip 2 rows", do you mean to skip down 2 rows from where the unique values were pasted (i.e. "rPaste(1)" or "rPaste(2)" + 2 rows)? And is there any pattern to the next column to check (i.e. check column D then E then F etc.)?

Thanks,
Ben

Hans Hamm

Bottom Up search for multiple entries

On Tuesday, October 30, 2012 9:56:18 AM UTC-4, Ben McClave wrote:
Hans,

I'm having trouble picturing what you would like to change. Would you mind posting the code you're using and insert comments where you would like the changes to occur?

As I understand it, the code currently cycles through each unique value in column D and pastes them in reverse order to two separate places. When you say "skip 2 rows", do you mean to skip down 2 rows from where the unique values were pasted (i.e. "rPaste(1)" or "rPaste(2)" + 2 rows)? And is there any pattern to the next column to check (i.e. check column D then E then F etc.)?

Thanks,

Ben

I actually have used your basic code 7-8 times in this report to provide data on different sections. I have for example a team section, store section, reason code section etc...
After the code you provided and the "sumproduct formula" to pull the #'s that correspond to each individual call in each section.
I will place "my needs" in **CAPS** inside the lines of code below

The section below is static and does not change, for your reference for date ranges also...

'STARTS OVERALL & TEAM DATA SECTION
Dim rng1 As Range 'Total # Of Calls
Dim rng2 As Range '# Of Closed Calls
Dim rng3 As Range '# Of Pending Calls
Dim rng4 As Range '# Of Open Calls

Set rng1 = Sheet1.Range("B3")
Set rng2 = Sheet1.Range("C3")
Set rng3 = Sheet1.Range("D3")
Set rng4 = Sheet1.Range("E3")

With rng1
.Formula = "=SUMPRODUCT((Sheet2!AJ2:AJ2000=Sheet1!C1)*(Sheet 2!AJ2:AJ2000<=Sheet1!E1))"
.Value = .Value
End With

With rng2
.Formula = "=SUMPRODUCT((Sheet2!AJ2:AJ2000=Sheet1!C1)*(Sheet 2!AJ2:AJ2000<=Sheet1!E1)*(Sheet2!G2:G2000=""Closed ""))"
.Value = .Value
End With

With rng3
.Formula = "=SUMPRODUCT((Sheet2!AJ2:AJ2000=Sheet1!C1)*(Sheet 2!AJ2:AJ2000<=Sheet1!E1)*(Sheet2!G2:G2000=""Pendin g""))"
.Value = .Value
End With

With rng4
.Formula = "=SUMPRODUCT((Sheet2!AJ2:AJ2000=Sheet1!C1)*(Sheet 2!AJ2:AJ2000<=Sheet1!E1)*(Sheet2!G2:G2000=""Open"" ))"
.Value = .Value
End With
**EVERYTHING ELSE BELOW IS SUBJECT TO CHANGE BASED ON THE DATE RANGES IN LOCATED IN CELLS C1 (START DATE) AND E1 (END DATE)
SO, I NEED THE CODE YOU PROVIDED TO BE ENHANCED BY LOOKING AT THE DATE RANGE AND ONLY RETURN THOSE WHICH FALL WITHIN THAT RANGE**

'STARTS STORE DATA SECTION

**THIS IS LAYMAN SPEAK HE IF THE DATE IN SHEET2 COLUMN AJ IS = SHEET1 CELL C1 (START DATE) AND IF THE DATE IN SHEET2 COLUMN AJ IS <= SHEET E1 (END DATE)
THEN FIND ALL RCOPY ITEMS THAT FALL WITHIN THAT DATE RANGE. I WILL TRY AND GIVE THIS AGAIN AT THE RCOPY LINE BELOW***

Dim rCopy As Range 'Range of values to check
Dim rCopy2 As Range 'Blank cell at the top of an unused column
Dim x As Long 'Used for cycling through the rCopy2 range
Dim y As Long 'Used for cycling through the rPaste range
Dim rPaste As Range 'First cell to receive the data

'First, set up the copy from range and the copy/paste to range
'Application.ScreenUpdating = False 'Uncomment this line if macro runs slow

IF SHEET2.RANGE("AJ2:AJ") = SHEET1.RANGE("C1") AND SHEET2.RANGE("AJ2:AJ"),= SHEET1.RANGE("E1")
THEN
Set rCopy = Sheet2.Range("H2:H" & lastRow)
Set rCopy2 = Sheet1.Range("AB1") 'Empty column somewhere in your workbook
Set rPaste = Sheet1.Range("A10")

y = 0 'Set to zero to start

'Next, resize the rCopy2 range to match the rCopy range size and copy the data
Set rCopy2 = rCopy2.Resize(rCopy.Rows.Count, 1)
rCopy.Copy rCopy2

'Now, remove duplicates (assumes no headers)
rCopy2.RemoveDuplicates 1, xlNo

'Once again resize rCopy2 to cover reduced data range
'**(Check next line to ensure that the sheet name and column are correct)
Set rCopy2 = Sheet1.Range("AB1:AB" & Sheet1.Range("AB64000").End(xlUp).Row)

'Now, cycle through each value in rCopy2 starting from the bottom _
and paste it to the final destination.
For x = rCopy2.Rows.Count To 1 Step -1
rPaste.Offset(y, 0).Value = rCopy2.Cells(x, 1)
y = y + 1 'Increment y to ensure next value goes into the cell below
Next x

'Finally, clear the rCopy2 range as it is no longer necessary.
rCopy2.Clear
Application.ScreenUpdating = True

THIS NOW GIVES ME ALL THE STORE POSITIONS THAT HAVE CALLED IN COLUMN A
THE NEXT SECTION GIVES ME THE # OF CALLS, CLOSED CALLS, PENDING CALLS ETC....

'Store # OF Calls

With Sheet1.Range("B10:B22")
..Formula = "=SUMPRODUCT((Sheet2!AJ$2:AJ$2000=Sheet1!C$1)*(Sh eet2!AJ$2:AJ$2000<=Sheet1!E$1)*(Sheet2!H$2:H$2000= Sheet1!A10))"
..Value = .Value
End With

'Store Closed Calls
With Sheet1.Range("C10:C22")
..Formula = "=SUMPRODUCT((Sheet2!AJ$2:AJ$2000=Sheet1!C$1)*(Sh eet2!AJ$2:AJ$2000<=Sheet1!E$1)*(Sheet2!H$2:H$2000= Sheet1!A10)*(Sheet2!G$2:G$2000=""Closed""))"
..Value = .Value
End With

'Store Pending Calls
With Sheet1.Range("D10:D22")
..Formula = "=SUMPRODUCT((Sheet2!AJ$2:AJ$2000=Sheet1!C$1)*(Sh eet2!AJ$2:AJ$2000<=Sheet1!E$1)*(Sheet2!H$2:H$2000= Sheet1!A10)*(Sheet2!G$2:G$2000=""Pending""))"
..Value = .Value
End With

'Store Open Calls
With Sheet1.Range("E10:E22")
..Formula = "=SUMPRODUCT((Sheet2!AJ$2:AJ$2000=Sheet1!C$1)*(Sh eet2!AJ$2:AJ$2000<=Sheet1!E$1)*(Sheet2!H$2:H$2000= Sheet1!A10)*(Sheet2!G$2:G$2000=""Open""))"
..Value = .Value
End With

****AFTER THIS HAS BEEN COMPLETED I NEED IT TO SKIP TWO ROWS DOWN AND START A NEW SECTION.*** BASICALLY REPEATING THIS ENTIRE PROCESS AGAIN.

If you cannot make sense of my gibberish I can send you the workbook if it will help.
Thanks Ben!!!

Hans Hamm

Bottom Up search for multiple entries

On Tuesday, October 30, 2012 11:34:55 AM UTC-4, Hans Hamm wrote:
On Tuesday, October 30, 2012 9:56:18 AM UTC-4, Ben McClave wrote:

Hans,

I'm having trouble picturing what you would like to change. Would you mind posting the code you're using and insert comments where you would like the changes to occur?

As I understand it, the code currently cycles through each unique value in column D and pastes them in reverse order to two separate places. When you say "skip 2 rows", do you mean to skip down 2 rows from where the unique values were pasted (i.e. "rPaste(1)" or "rPaste(2)" + 2 rows)? And is there any pattern to the next column to check (i.e. check column D then E then F etc.)?

Thanks,

Ben

I actually have used your basic code 7-8 times in this report to provide data on different sections. I have for example a team section, store section, reason code section etc...

After the code you provided and the "sumproduct formula" to pull the #'s that correspond to each individual call in each section.

I will place "my needs" in **CAPS** inside the lines of code below

The section below is static and does not change, for your reference for date ranges also...

'STARTS OVERALL & TEAM DATA SECTION

Dim rng1 As Range 'Total # Of Calls

Dim rng2 As Range '# Of Closed Calls

Dim rng3 As Range '# Of Pending Calls

Dim rng4 As Range '# Of Open Calls

Set rng1 = Sheet1.Range("B3")

Set rng2 = Sheet1.Range("C3")

Set rng3 = Sheet1.Range("D3")

Set rng4 = Sheet1.Range("E3")

With rng1

.Formula = "=SUMPRODUCT((Sheet2!AJ2:AJ2000=Sheet1!C1)*(Sheet 2!AJ2:AJ2000<=Sheet1!E1))"

.Value = .Value

End With

With rng2

.Formula = "=SUMPRODUCT((Sheet2!AJ2:AJ2000=Sheet1!C1)*(Sheet 2!AJ2:AJ2000<=Sheet1!E1)*(Sheet2!G2:G2000=""Closed ""))"

.Value = .Value

End With

With rng3

.Formula = "=SUMPRODUCT((Sheet2!AJ2:AJ2000=Sheet1!C1)*(Sheet 2!AJ2:AJ2000<=Sheet1!E1)*(Sheet2!G2:G2000=""Pendin g""))"

.Value = .Value

End With

With rng4

.Formula = "=SUMPRODUCT((Sheet2!AJ2:AJ2000=Sheet1!C1)*(Sheet 2!AJ2:AJ2000<=Sheet1!E1)*(Sheet2!G2:G2000=""Open"" ))"

.Value = .Value

End With

**EVERYTHING ELSE BELOW IS SUBJECT TO CHANGE BASED ON THE DATE RANGES IN LOCATED IN CELLS C1 (START DATE) AND E1 (END DATE)

SO, I NEED THE CODE YOU PROVIDED TO BE ENHANCED BY LOOKING AT THE DATE RANGE AND ONLY RETURN THOSE WHICH FALL WITHIN THAT RANGE**

'STARTS STORE DATA SECTION

**THIS IS LAYMAN SPEAK HE IF THE DATE IN SHEET2 COLUMN AJ IS = SHEET1 CELL C1 (START DATE) AND IF THE DATE IN SHEET2 COLUMN AJ IS <= SHEET E1 (END DATE)

THEN FIND ALL RCOPY ITEMS THAT FALL WITHIN THAT DATE RANGE. I WILL TRY AND GIVE THIS AGAIN AT THE RCOPY LINE BELOW***

Dim rCopy As Range 'Range of values to check

Dim rCopy2 As Range 'Blank cell at the top of an unused column

Dim x As Long 'Used for cycling through the rCopy2 range

Dim y As Long 'Used for cycling through the rPaste range

Dim rPaste As Range 'First cell to receive the data

'First, set up the copy from range and the copy/paste to range

'Application.ScreenUpdating = False 'Uncomment this line if macro runs slow

IF SHEET2.RANGE("AJ2:AJ") = SHEET1.RANGE("C1") AND SHEET2.RANGE("AJ2:AJ"),= SHEET1.RANGE("E1")

THEN

Set rCopy = Sheet2.Range("H2:H" & lastRow)

Set rCopy2 = Sheet1.Range("AB1") 'Empty column somewhere in your workbook

Set rPaste = Sheet1.Range("A10")

y = 0 'Set to zero to start

'Next, resize the rCopy2 range to match the rCopy range size and copy the data

Set rCopy2 = rCopy2.Resize(rCopy.Rows.Count, 1)

rCopy.Copy rCopy2

'Now, remove duplicates (assumes no headers)

rCopy2.RemoveDuplicates 1, xlNo

'Once again resize rCopy2 to cover reduced data range

'**(Check next line to ensure that the sheet name and column are correct)

Set rCopy2 = Sheet1.Range("AB1:AB" & Sheet1.Range("AB64000").End(xlUp).Row)

'Now, cycle through each value in rCopy2 starting from the bottom _

and paste it to the final destination.

For x = rCopy2.Rows.Count To 1 Step -1

rPaste.Offset(y, 0).Value = rCopy2.Cells(x, 1)

y = y + 1 'Increment y to ensure next value goes into the cell below

Next x

'Finally, clear the rCopy2 range as it is no longer necessary.

rCopy2.Clear

Application.ScreenUpdating = True

THIS NOW GIVES ME ALL THE STORE POSITIONS THAT HAVE CALLED IN COLUMN A

THE NEXT SECTION GIVES ME THE # OF CALLS, CLOSED CALLS, PENDING CALLS ETC....

'Store # OF Calls

With Sheet1.Range("B10:B22")

.Formula = "=SUMPRODUCT((Sheet2!AJ$2:AJ$2000=Sheet1!C$1)*(Sh eet2!AJ$2:AJ$2000<=Sheet1!E$1)*(Sheet2!H$2:H$2000= Sheet1!A10))"

.Value = .Value

End With

'Store Closed Calls

With Sheet1.Range("C10:C22")

.Formula = "=SUMPRODUCT((Sheet2!AJ$2:AJ$2000=Sheet1!C$1)*(Sh eet2!AJ$2:AJ$2000<=Sheet1!E$1)*(Sheet2!H$2:H$2000= Sheet1!A10)*(Sheet2!G$2:G$2000=""Closed""))"

.Value = .Value

End With

'Store Pending Calls

With Sheet1.Range("D10:D22")

.Formula = "=SUMPRODUCT((Sheet2!AJ$2:AJ$2000=Sheet1!C$1)*(Sh eet2!AJ$2:AJ$2000<=Sheet1!E$1)*(Sheet2!H$2:H$2000= Sheet1!A10)*(Sheet2!G$2:G$2000=""Pending""))"

.Value = .Value

End With

'Store Open Calls

With Sheet1.Range("E10:E22")

.Formula = "=SUMPRODUCT((Sheet2!AJ$2:AJ$2000=Sheet1!C$1)*(Sh eet2!AJ$2:AJ$2000<=Sheet1!E$1)*(Sheet2!H$2:H$2000= Sheet1!A10)*(Sheet2!G$2:G$2000=""Open""))"

.Value = .Value

End With

****AFTER THIS HAS BEEN COMPLETED I NEED IT TO SKIP TWO ROWS DOWN AND START A NEW SECTION.*** BASICALLY REPEATING THIS ENTIRE PROCESS AGAIN.

If you cannot make sense of my gibberish I can send you the workbook if it will help.

Thanks Ben!!!

Ben an additional point I guess I should make and this is what I am head scratching about... if, for example this month the Store Data section contains 5 listings say (A5:A10), but next month it contains 10. I need the code you provided to expand to the 10 (A5:A15), which it does. But, also how do I get the sumproduct formulas to work within that "new" range from A5:A10 to A5:A15?

Ben McClave

Bottom Up search for multiple entries

Hans,

The code I wrote (below) is not pretty, but I think that it will do the trick. Give it a try and see if this helps.

Ben

'STARTS OVERALL & TEAM DATA SECTION
Dim rng1 As Range 'Total # Of Calls
Dim rng2 As Range '# Of Closed Calls
Dim rng3 As Range '# Of Pending Calls
Dim rng4 As Range '# Of Open Calls

'Uncomment next line to delete prior month's data (rows 3 and down)
'Sheet1.Range("3:" & Sheet1.UsedRange.Rows.Count).ClearContents

Set rng1 = Sheet1.Range("B3")
Set rng2 = Sheet1.Range("C3")
Set rng3 = Sheet1.Range("D3")
Set rng4 = Sheet1.Range("E3")

With rng1
.Formula = "=SUMPRODUCT((Sheet2!AJ2:AJ2000=Sheet1!C1)*(Sheet 2!AJ2:AJ2000<=Sheet1!E1))"
.Value = .Value
End With

With rng2
.Formula = "=SUMPRODUCT((Sheet2!AJ2:AJ2000=Sheet1!C1)*(Sheet 2!AJ2:AJ2000<=Sheet1!E1)*(Sheet2!G2:G2000=""Closed ""))"
.Value = .Value
End With

With rng3
.Formula = "=SUMPRODUCT((Sheet2!AJ2:AJ2000=Sheet1!C1)*(Sheet 2!AJ2:AJ2000<=Sheet1!E1)*(Sheet2!G2:G2000=""Pendin g""))"
.Value = .Value
End With

With rng4
.Formula = "=SUMPRODUCT((Sheet2!AJ2:AJ2000=Sheet1!C1)*(Sheet 2!AJ2:AJ2000<=Sheet1!E1)*(Sheet2!G2:G2000=""Open"" ))"
.Value = .Value
End With
'**EVERYTHING ELSE BELOW IS SUBJECT TO CHANGE BASED ON THE DATE RANGES IN LOCATED IN CELLS C1 (START DATE) AND E1 (END DATE)
' SO, I NEED THE CODE YOU PROVIDED TO BE ENHANCED BY LOOKING AT THE DATE RANGE AND ONLY RETURN THOSE WHICH FALL WITHIN THAT RANGE**

'STARTS STORE DATA SECTION

'**THIS IS LAYMAN SPEAK HE IF THE DATE IN SHEET2 COLUMN AJ IS = SHEET1 CELL C1 (START DATE) AND IF THE DATE IN SHEET2 COLUMN AJ IS <= SHEET E1 (END DATE)
' THEN FIND ALL RCOPY ITEMS THAT FALL WITHIN THAT DATE RANGE. I WILL TRY AND GIVE THIS AGAIN AT THE RCOPY LINE BELOW***

Dim wsNew As Worksheet 'New worksheet for data manipulation
Dim rCopy As Range 'Range of values to check
Dim rCopy2 As Range 'Blank cell at the top of an unused column
Dim rCheck As Range 'Range of dates to check
Dim x As Long 'Used for cycling through the rCopy2 range
Dim y As Long 'Used for cycling through the rPaste range
Dim lastRow As Long 'Last row in column
Dim rPaste As Range 'First cell to receive the data

'First, set up the copy from range and the copy/paste to range
'Application.ScreenUpdating = False 'Uncomment this line if macro runs slow

'IF SHEET2.RANGE("AJ2:AJ") = SHEET1.RANGE("C1") AND SHEET2.RANGE("AJ2:AJ"),= SHEET1.RANGE("E1") _
THEN
lastRow = Sheet2.Range("H50000").End(xlUp).Row
Set wsNew = Worksheets.Add
Set rCopy = Sheet2.Range("H1:AJ" & lastRow) 'Be sure to include both the data you want and the date here with column headings.
Set rCheck = Sheet2.Range("AJ2:AJ" & Sheet2.Range("AJ50000").End(xlUp).Row)
Set rPaste = Sheet1.Range("A10")

'Prepare criteria for the search
With wsNew
.Range("A1:B1").Value = rCheck.Offset(-1).Value
.Range("A2").FormulaR1C1 = "=""="" & Sheet1!R1C3"
.Range("B2").FormulaR1C1 = "=""<="" & Sheet1!R1C5"
.Range("A2:B2").Value = .Range("A2:B2").Value
Set rCopy2 = .Range("G1")
rCopy2.Value = rCopy.Value
rCopy.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("A1:B2"), CopyToRange:=rCopy2, Unique:=True
End With

y = 0 'Set to zero to start

'Next, resize the rCopy2 range to match the rCopy range size
Set rCopy2 = rCopy2.Resize(wsNew.UsedRange.Rows.Count, 1)

'Now, cycle through each value in rCopy2 starting from the bottom _
and paste it to the final destination.
Dim lRows As Long
lRows = rCopy2.Rows.Count
For x = lRows To 2 Step -1

rPaste.Offset(y, 0).Value = rCopy2.Cells(x, 1)

y = y + 1 'Increment y to ensure next value goes into the cell below
Next x

'Finally, delete the wsNew sheet as it is no longer necessary.
Application.DisplayAlerts = False
wsNew.Delete
Application.DisplayAlerts = True

'THIS NOW GIVES ME ALL THE STORE POSITIONS THAT HAVE CALLED IN COLUMN A
'THE NEXT SECTION GIVES ME THE # OF CALLS, CLOSED CALLS, PENDING CALLS ETC...

'Store # OF Calls
lRows = lRows + 8
With Sheet1.Range("B10:B" & lRows)
..Formula = "=SUMPRODUCT((Sheet2!AJ$2:AJ$2000=Sheet1!C$1)*(Sh eet2!AJ$2:AJ$2000<=Sheet1!E$1)*(Sheet2!H$2:H$2000= Sheet1!A10))"
'.Value = .Value
End With

'Store Closed Calls
With Sheet1.Range("C10:C" & lRows)
..Formula = "=SUMPRODUCT((Sheet2!AJ$2:AJ$2000=Sheet1!C$1)*(Sh eet2!AJ$2:AJ$2000<=Sheet1!E$1)*(Sheet2!H$2:H$2000= Sheet1!A10)*(Sheet2!G$2:G$2000=""Closed""))"
'.Value = .Value
End With

'Store Pending Calls
With Sheet1.Range("D10:D" & lRows)
..Formula = "=SUMPRODUCT((Sheet2!AJ$2:AJ$2000=Sheet1!C$1)*(Sh eet2!AJ$2:AJ$2000<=Sheet1!E$1)*(Sheet2!H$2:H$2000= Sheet1!A10)*(Sheet2!G$2:G$2000=""Pending""))"
'.Value = .Value
End With

'Store Open Calls
With Sheet1.Range("E10:E" & lRows)
..Formula = "=SUMPRODUCT((Sheet2!AJ$2:AJ$2000=Sheet1!C$1)*(Sh eet2!AJ$2:AJ$2000<=Sheet1!E$1)*(Sheet2!H$2:H$2000= Sheet1!A10)*(Sheet2!G$2:G$2000=""Open""))"
'.Value = .Value
End With

'Copies the data and pastes it two rows down
Sheet1.Range("10:" & lRows).Copy Sheet1.Range(lRows + 3 & ":" & lRows + 3)
Application.ScreenUpdating = True

Hans Hamm

Bottom Up search for multiple entries

On Tuesday, October 30, 2012 4:26:47 PM UTC-4, Ben McClave wrote:
Hans,

The code I wrote (below) is not pretty, but I think that it will do the trick. Give it a try and see if this helps.

Ben

'STARTS OVERALL & TEAM DATA SECTION

Dim rng1 As Range 'Total # Of Calls

Dim rng2 As Range '# Of Closed Calls

Dim rng3 As Range '# Of Pending Calls

Dim rng4 As Range '# Of Open Calls

'Uncomment next line to delete prior month's data (rows 3 and down)

'Sheet1.Range("3:" & Sheet1.UsedRange.Rows.Count).ClearContents

Set rng1 = Sheet1.Range("B3")

Set rng2 = Sheet1.Range("C3")

Set rng3 = Sheet1.Range("D3")

Set rng4 = Sheet1.Range("E3")

With rng1

.Formula = "=SUMPRODUCT((Sheet2!AJ2:AJ2000=Sheet1!C1)*(Sheet 2!AJ2:AJ2000<=Sheet1!E1))"

.Value = .Value

End With

With rng2

.Formula = "=SUMPRODUCT((Sheet2!AJ2:AJ2000=Sheet1!C1)*(Sheet 2!AJ2:AJ2000<=Sheet1!E1)*(Sheet2!G2:G2000=""Closed ""))"

.Value = .Value

End With

With rng3

.Formula = "=SUMPRODUCT((Sheet2!AJ2:AJ2000=Sheet1!C1)*(Sheet 2!AJ2:AJ2000<=Sheet1!E1)*(Sheet2!G2:G2000=""Pendin g""))"

.Value = .Value

End With

With rng4

.Formula = "=SUMPRODUCT((Sheet2!AJ2:AJ2000=Sheet1!C1)*(Sheet 2!AJ2:AJ2000<=Sheet1!E1)*(Sheet2!G2:G2000=""Open"" ))"

.Value = .Value

End With

'**EVERYTHING ELSE BELOW IS SUBJECT TO CHANGE BASED ON THE DATE RANGES IN LOCATED IN CELLS C1 (START DATE) AND E1 (END DATE)

' SO, I NEED THE CODE YOU PROVIDED TO BE ENHANCED BY LOOKING AT THE DATE RANGE AND ONLY RETURN THOSE WHICH FALL WITHIN THAT RANGE**

'STARTS STORE DATA SECTION

'**THIS IS LAYMAN SPEAK HE IF THE DATE IN SHEET2 COLUMN AJ IS = SHEET1 CELL C1 (START DATE) AND IF THE DATE IN SHEET2 COLUMN AJ IS <= SHEET E1 (END DATE)

' THEN FIND ALL RCOPY ITEMS THAT FALL WITHIN THAT DATE RANGE. I WILL TRY AND GIVE THIS AGAIN AT THE RCOPY LINE BELOW***

Dim wsNew As Worksheet 'New worksheet for data manipulation

Dim rCopy As Range 'Range of values to check

Dim rCopy2 As Range 'Blank cell at the top of an unused column

Dim rCheck As Range 'Range of dates to check

Dim x As Long 'Used for cycling through the rCopy2 range

Dim y As Long 'Used for cycling through the rPaste range

Dim lastRow As Long 'Last row in column

Dim rPaste As Range 'First cell to receive the data

'First, set up the copy from range and the copy/paste to range

'Application.ScreenUpdating = False 'Uncomment this line if macro runs slow

'IF SHEET2.RANGE("AJ2:AJ") = SHEET1.RANGE("C1") AND SHEET2.RANGE("AJ2:AJ"),= SHEET1.RANGE("E1") _

THEN

lastRow = Sheet2.Range("H50000").End(xlUp).Row

Set wsNew = Worksheets.Add

Set rCopy = Sheet2.Range("H1:AJ" & lastRow) 'Be sure to include both the data you want and the date here with column headings.

Set rCheck = Sheet2.Range("AJ2:AJ" & Sheet2.Range("AJ50000").End(xlUp).Row)

Set rPaste = Sheet1.Range("A10")

'Prepare criteria for the search

With wsNew

.Range("A1:B1").Value = rCheck.Offset(-1).Value

.Range("A2").FormulaR1C1 = "=""="" & Sheet1!R1C3"

.Range("B2").FormulaR1C1 = "=""<="" & Sheet1!R1C5"

.Range("A2:B2").Value = .Range("A2:B2").Value

Set rCopy2 = .Range("G1")

rCopy2.Value = rCopy.Value

rCopy.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("A1:B2"), CopyToRange:=rCopy2, Unique:=True

End With

y = 0 'Set to zero to start

'Next, resize the rCopy2 range to match the rCopy range size

Set rCopy2 = rCopy2.Resize(wsNew.UsedRange.Rows.Count, 1)

'Now, cycle through each value in rCopy2 starting from the bottom _

and paste it to the final destination.

Dim lRows As Long

lRows = rCopy2.Rows.Count

For x = lRows To 2 Step -1

rPaste.Offset(y, 0).Value = rCopy2.Cells(x, 1)

y = y + 1 'Increment y to ensure next value goes into the cell below

Next x

'Finally, delete the wsNew sheet as it is no longer necessary.

Application.DisplayAlerts = False

wsNew.Delete

Application.DisplayAlerts = True

'THIS NOW GIVES ME ALL THE STORE POSITIONS THAT HAVE CALLED IN COLUMN A

'THE NEXT SECTION GIVES ME THE # OF CALLS, CLOSED CALLS, PENDING CALLS ETC...

'Store # OF Calls

lRows = lRows + 8

With Sheet1.Range("B10:B" & lRows)

.Formula = "=SUMPRODUCT((Sheet2!AJ$2:AJ$2000=Sheet1!C$1)*(Sh eet2!AJ$2:AJ$2000<=Sheet1!E$1)*(Sheet2!H$2:H$2000= Sheet1!A10))"

'.Value = .Value

End With

'Store Closed Calls

With Sheet1.Range("C10:C" & lRows)

.Formula = "=SUMPRODUCT((Sheet2!AJ$2:AJ$2000=Sheet1!C$1)*(Sh eet2!AJ$2:AJ$2000<=Sheet1!E$1)*(Sheet2!H$2:H$2000= Sheet1!A10)*(Sheet2!G$2:G$2000=""Closed""))"

'.Value = .Value

End With

'Store Pending Calls

With Sheet1.Range("D10:D" & lRows)

.Formula = "=SUMPRODUCT((Sheet2!AJ$2:AJ$2000=Sheet1!C$1)*(Sh eet2!AJ$2:AJ$2000<=Sheet1!E$1)*(Sheet2!H$2:H$2000= Sheet1!A10)*(Sheet2!G$2:G$2000=""Pending""))"

'.Value = .Value

End With

'Store Open Calls

With Sheet1.Range("E10:E" & lRows)

.Formula = "=SUMPRODUCT((Sheet2!AJ$2:AJ$2000=Sheet1!C$1)*(Sh eet2!AJ$2:AJ$2000<=Sheet1!E$1)*(Sheet2!H$2:H$2000= Sheet1!A10)*(Sheet2!G$2:G$2000=""Open""))"

'.Value = .Value

End With

'Copies the data and pastes it two rows down

Sheet1.Range("10:" & lRows).Copy Sheet1.Range(lRows + 3 & ":" & lRows + 3)

Application.ScreenUpdating = True

One thing I noticed and I can't track down is, that it repeats itself. Example, and it works GREAT by the way. Starting with Cell A10 (going across to E10 and down the range) it gives me all the info. But then it skips two rows (which is what I need) but repeats the same data set. (which I don't need) as I said earlier this works exactly like I need, but you are so far over my head in this that I cannot figure out the repeated data.
I am DEFINITELY going to vary this somewhat after I get a full grasp of how you are doing it and use it several times in this report and future ones....WOW

Ben McClave

Bottom Up search for multiple entries

Hans,

The reason it repeats is because of the second to last line (see last three lines copied below).

'Copies the data and pastes it two rows down
Sheet1.Range("10:" & lRows).Copy Sheet1.Range(lRows + 3 & ":" & lRows + 3)
Application.ScreenUpdating = True

I wasn't sure what information you wanted to show up when it went two rows down, so as a placeholder, it simply copies what was done above to the row two rows down.

You can change the second-to-last line to the following:

Sheet1.Range(lRows + 3 & ":" & lRows + 3).Select

to select the entire row, or use

Sheet1.Range("A" & lRows + 3).Select

to select the cell from column A two rows down. Using one of those two lines instead of

Sheet1.Range("10:" & lRows).Copy Sheet1.Range(lRows + 3 & ":" & lRows + 3)

will solve the issue with the macro copying the data twice. You can then insert whatever code you need at that point. If this isn't making sense, feel free to send me your file so that I can get a better feel for what you would like to populate on the row two lines down.

Ben

Hans Hamm

Bottom Up search for multiple entries

On Wednesday, October 31, 2012 4:48:05 PM UTC-4, Ben McClave wrote:
Hans,

The reason it repeats is because of the second to last line (see last three lines copied below).

'Copies the data and pastes it two rows down

Sheet1.Range("10:" & lRows).Copy Sheet1.Range(lRows + 3 & ":" & lRows + 3)

Application.ScreenUpdating = True

I wasn't sure what information you wanted to show up when it went two rows down, so as a placeholder, it simply copies what was done above to the row two rows down.

You can change the second-to-last line to the following:

Sheet1.Range(lRows + 3 & ":" & lRows + 3).Select

to select the entire row, or use

Sheet1.Range("A" & lRows + 3).Select

to select the cell from column A two rows down. Using one of those two lines instead of

Sheet1.Range("10:" & lRows).Copy Sheet1.Range(lRows + 3 & ":" & lRows + 3)

will solve the issue with the macro copying the data twice. You can then insert whatever code you need at that point. If this isn't making sense, feel free to send me your file so that I can get a better feel for what you would like to populate on the row two lines down.

Ben

Ben when I take the line of code out... it does exactly what I need it to do. The problem is this; once this has run I need some way of telling it to look in Column A find the very last entry and then skip down two rows and start a new section. For Example: This date range may produce 7 different results as below, or it may be 5 or 25. The code you have is doing this perfectly.

COLUMN A B C D E F

Row 10 STORE CallLogs
11 MASM 1 1 0 0 1.0
12 SASM 1 1 0 0 1.0
13 SM 1 1 0 0 1.0
14 ASDS 1 1 0 0 1.0
15 MET 1 1 0 0 1.0
16 OPSMGR 4 4 0 0 1.0
17 MEAS 5 5 0 0 2.2
18 DH 13 13 0 0 1.3

Now I need to tell it to skip down two rows from the last entry in column A and do something like this
Dim SSection As Range
Set SSection = Sheet1.Range("A20") *** this will be the dynamic range based on the aforementioned different quantity of results (7, 10, 25 or whatever)
With SSection
..Value = ("REASON CODE CallLogs")
End With

Now the plan is to repeat the entire process as you have provided, but based on different criteria... instead of store Calls, it is now looking for Reason Codes. I think I am understanding your code well enough to reproduce.

Ben McClave

Bottom Up search for multiple entries

Hans,

I reworked this for you a bit. Rather than continue to layer procedures, I changed the sub to take arguments indicating (1) where the data resides in your workbook, (2) what range contains the information you want to summarize, (3) a string equivalent of this range to use in formulas, and (4) a formula string to make the SUMPRODUCT formula easier to work with.

At the top of the code is a Public variable called lStartRow. This value is initially set to 10 so that data begins to fill on row ten. Then, as the macros run, the lStartRow is adjusted to the next SECTION.

Finally, there is a macro called SummarizeData you can use to run each section. I included two potential sections of data for an example, but you can modify this routine to match your needs.

To use this, make your changes to the SummarizeData macro and then run it. that macro will call all of the others one at a time. Let me know if this works out OK for you.

Ben

Public lStartRow As Long
Sub SummarizeData()
Dim rData As Range 'Location of your data table
Dim sFrm As String 'SUMPRODUCT formula base

Application.ScreenUpdating = False

Sheet1.Rows("10:60000").ClearContents
Set rData = Sheet2.Range("A1:AJ2000")
sFrm = "=SUMPRODUCT((Sheet2!AJ$2:AJ$2000=Sheet1!C$1)*(Sh eet2!AJ$2:AJ$2000<=Sheet1!E$1)"

'First, get Team/Overall Data (takes formula base as only argument)
TeamData sFrm

'Next, get Store data (assumes stores in Sheet2, range H1:H2000)
lStartRow = 10 'Only need to set this once
GetDataDetails rData, Sheet2.Range("H1:H2000"), "Sheet2!H$2:H$2000", sFrm

'Now that Store is done, move to next item of interest (assumes data in Sheet2, range G1:G2000)
GetDataDetails rData, Sheet2.Range("G1:G2000"), "Sheet2!G$2:G$2000", sFrm

'Continue for any other details you need.

Application.ScreenUpdating = True
End Sub

Sub TeamData(sFormula As String)
'GETS OVERALL & TEAM DATA SECTION

With Sheet1.Range("B3")
.Formula = sFormula & ")"
.Value = .Value
End With

With Sheet1.Range("C3")
.Formula = sFormula & "*(Sheet2!G2:G2000=""Closed""))"
.Value = .Value
End With

With Sheet1.Range("D3")
.Formula = sFormula & "*(Sheet2!G2:G2000=""Pending""))"
.Value = .Value
End With

With Sheet1.Range("E3")
.Formula = sFormula & "*(Sheet2!G2:G2000=""Open""))"
.Value = .Value
End With

End Sub

Sub GetDataDetails(rDataRange As Range, rDetailRange As Range, sCompare As String, sForm As String)
'rDataRange is where your data is located
'rDetailRange is the range you wish to summarize (i.e. STORES, REASONS, etc..)
'sCompare is the string representing the range of values to lookup on sheet2 (i.e. Store names, Reason codes, etc.)

Dim wsNew As Worksheet 'New worksheet for data manipulation
Dim rCopy2 As Range 'Blank cell at the top of an unused column
Dim rDateCheck As Range 'Range of dates to check

Dim x As Long 'Used for cycling through the rCopy2 range
Dim y As Long 'Used for cycling through the rPaste range

Dim lastRow As Long 'Last row in column
Dim rPaste As Range 'First cell to receive the data

lastRow = Range(sCompare).Rows.Count + Range(sCompare).Range("A1").Row - 1
Set wsNew = Worksheets.Add
Set rDetailRange = rDetailRange.Resize(lastRow, rDetailRange.Columns.Count)
Set rDateCheck = Sheet2.Range("AJ2:AJ" & Sheet2.Range("AJ50000").End(xlUp).Row)
Set rPaste = Sheet1.Range("A" & lStartRow)

'Prepare criteria for the search
With wsNew
.Range("A1:B1").Value = rDateCheck.Offset(-1).Value
.Range("A2").FormulaR1C1 = "=""="" & Sheet1!R1C3"
.Range("B2").FormulaR1C1 = "=""<="" & Sheet1!R1C5"
.Range("A2:B2").Value = .Range("A2:B2").Value
Set rCopy2 = .Range("G1")
rCopy2.Value = rDetailRange.Value
rDataRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=..Range("A1:B2"), CopyToRange:=rCopy2, Unique:=True
End With

y = 0 'Set to zero to start

'Next, resize the rCopy2 range to match the rDetailRange range size

Set rCopy2 = rCopy2.Resize(wsNew.UsedRange.Rows.Count, 1)

'Now, cycle through each value in rCopy2 starting from the bottom _
and paste it to the final destination.

Dim lRows As Long
lRows = rCopy2.Rows.Count
For x = lRows To 2 Step -1

rPaste.Offset(y, 0).Value = rCopy2.Cells(x, 1)

y = y + 1 'Increment y to ensure next value goes into the cell below
Next x

'Finally, delete the wsNew sheet as it is no longer necessary.
Application.DisplayAlerts = False
wsNew.Delete
Application.DisplayAlerts = True

lRows = lStartRow + lRows - 2
With Sheet1.Range("B" & lStartRow & ":B" & lRows)

..Formula = sForm & "*(" & sCompare & "=Sheet1!A" & lStartRow & "))"
'.Value = .Value
End With

'Store Closed Calls

With Sheet1.Range("C" & lStartRow & ":C" & lRows)

..Formula = sForm & "*(" & sCompare & "=Sheet1!A" & lStartRow & ")*(Sheet2!G$2:G$2000=""Closed""))"
'.Value = .Value
End With

'Store Pending Calls

With Sheet1.Range("D" & lStartRow & ":D" & lRows)

..Formula = sForm & "*(" & sCompare & "=Sheet1!A" & lStartRow & ")*(Sheet2!G$2:G$2000=""Pending""))"
'.Value = .Value
End With

'Store Open Calls

With Sheet1.Range("E" & lStartRow & ":E" & lRows)

..Formula = sForm & "*(" & sCompare & "=Sheet1!A" & lStartRow & ")*(Sheet2!G$2:G$2000=""Open""))"
'.Value = .Value
End With

'Copies the data and pastes it two rows down
lStartRow = lRows + 3

End Sub

Hans Hamm

Bottom Up search for multiple entries

On Thursday, November 1, 2012 1:31:33 PM UTC-4, Ben McClave wrote:
Hans,

I reworked this for you a bit. Rather than continue to layer procedures, I changed the sub to take arguments indicating (1) where the data resides in your workbook, (2) what range contains the information you want to summarize, (3) a string equivalent of this range to use in formulas, and (4) a formula string to make the SUMPRODUCT formula easier to work with.

At the top of the code is a Public variable called lStartRow. This value is initially set to 10 so that data begins to fill on row ten. Then, as the macros run, the lStartRow is adjusted to the next SECTION.

Finally, there is a macro called SummarizeData you can use to run each section. I included two potential sections of data for an example, but you can modify this routine to match your needs.

To use this, make your changes to the SummarizeData macro and then run it.. that macro will call all of the others one at a time. Let me know if this works out OK for you.

Ben

Public lStartRow As Long

Sub SummarizeData()

Dim rData As Range 'Location of your data table

Dim sFrm As String 'SUMPRODUCT formula base

Application.ScreenUpdating = False

Sheet1.Rows("10:60000").ClearContents

Set rData = Sheet2.Range("A1:AJ2000")

sFrm = "=SUMPRODUCT((Sheet2!AJ$2:AJ$2000=Sheet1!C$1)*(Sh eet2!AJ$2:AJ$2000<=Sheet1!E$1)"

'First, get Team/Overall Data (takes formula base as only argument)

TeamData sFrm

'Next, get Store data (assumes stores in Sheet2, range H1:H2000)

lStartRow = 10 'Only need to set this once

GetDataDetails rData, Sheet2.Range("H1:H2000"), "Sheet2!H$2:H$2000", sFrm

'Now that Store is done, move to next item of interest (assumes data in Sheet2, range G1:G2000)

GetDataDetails rData, Sheet2.Range("G1:G2000"), "Sheet2!G$2:G$2000", sFrm

'Continue for any other details you need.

Application.ScreenUpdating = True

End Sub

Sub TeamData(sFormula As String)

'GETS OVERALL & TEAM DATA SECTION

With Sheet1.Range("B3")

.Formula = sFormula & ")"

.Value = .Value

End With

With Sheet1.Range("C3")

.Formula = sFormula & "*(Sheet2!G2:G2000=""Closed""))"

.Value = .Value

End With

With Sheet1.Range("D3")

.Formula = sFormula & "*(Sheet2!G2:G2000=""Pending""))"

.Value = .Value

End With

With Sheet1.Range("E3")

.Formula = sFormula & "*(Sheet2!G2:G2000=""Open""))"

.Value = .Value

End With

End Sub

Sub GetDataDetails(rDataRange As Range, rDetailRange As Range, sCompare As String, sForm As String)

'rDataRange is where your data is located

'rDetailRange is the range you wish to summarize (i.e. STORES, REASONS, etc.)

'sCompare is the string representing the range of values to lookup on sheet2 (i.e. Store names, Reason codes, etc.)

Dim wsNew As Worksheet 'New worksheet for data manipulation

Dim rCopy2 As Range 'Blank cell at the top of an unused column

Dim rDateCheck As Range 'Range of dates to check

Dim x As Long 'Used for cycling through the rCopy2 range

Dim y As Long 'Used for cycling through the rPaste range

Dim lastRow As Long 'Last row in column

Dim rPaste As Range 'First cell to receive the data

lastRow = Range(sCompare).Rows.Count + Range(sCompare).Range("A1").Row - 1

Set wsNew = Worksheets.Add

Set rDetailRange = rDetailRange.Resize(lastRow, rDetailRange.Columns.Count)

Set rDateCheck = Sheet2.Range("AJ2:AJ" & Sheet2.Range("AJ50000").End(xlUp).Row)

Set rPaste = Sheet1.Range("A" & lStartRow)

'Prepare criteria for the search

With wsNew

.Range("A1:B1").Value = rDateCheck.Offset(-1).Value

.Range("A2").FormulaR1C1 = "=""="" & Sheet1!R1C3"

.Range("B2").FormulaR1C1 = "=""<="" & Sheet1!R1C5"

.Range("A2:B2").Value = .Range("A2:B2").Value

Set rCopy2 = .Range("G1")

rCopy2.Value = rDetailRange.Value

rDataRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("A1:B2"), CopyToRange:=rCopy2, Unique:=True

End With

y = 0 'Set to zero to start

'Next, resize the rCopy2 range to match the rDetailRange range size

Set rCopy2 = rCopy2.Resize(wsNew.UsedRange.Rows.Count, 1)

'Now, cycle through each value in rCopy2 starting from the bottom _

and paste it to the final destination.

Dim lRows As Long

lRows = rCopy2.Rows.Count

For x = lRows To 2 Step -1

rPaste.Offset(y, 0).Value = rCopy2.Cells(x, 1)

y = y + 1 'Increment y to ensure next value goes into the cell below

Next x

'Finally, delete the wsNew sheet as it is no longer necessary.

Application.DisplayAlerts = False

wsNew.Delete

Application.DisplayAlerts = True

lRows = lStartRow + lRows - 2

With Sheet1.Range("B" & lStartRow & ":B" & lRows)

.Formula = sForm & "*(" & sCompare & "=Sheet1!A" & lStartRow & "))"

'.Value = .Value

End With

'Store Closed Calls

With Sheet1.Range("C" & lStartRow & ":C" & lRows)

.Formula = sForm & "*(" & sCompare & "=Sheet1!A" & lStartRow & ")*(Sheet2!G$2:G$2000=""Closed""))"

'.Value = .Value

End With

'Store Pending Calls

With Sheet1.Range("D" & lStartRow & ":D" & lRows)

.Formula = sForm & "*(" & sCompare & "=Sheet1!A" & lStartRow & ")*(Sheet2!G$2:G$2000=""Pending""))"

'.Value = .Value

End With

'Store Open Calls

With Sheet1.Range("E" & lStartRow & ":E" & lRows)

.Formula = sForm & "*(" & sCompare & "=Sheet1!A" & lStartRow & ")*(Sheet2!G$2:G$2000=""Open""))"

'.Value = .Value

End With

'Copies the data and pastes it two rows down

lStartRow = lRows + 3

End Sub

It seems to work even though I am almost clueless how you did this... give me a few days to digest and I will probably ask you a couple of questions. I think I am fairly good with formulas, but VBA gives you so much more room for manipulation. That is why I have decided to go back and try to learn it. And you have given me a plate full to digest here. Ben I really appreciate your time and effort in working this out for me.

Hans Hamm

Bottom Up search for multiple entries

On Thursday, November 1, 2012 2:56:57 PM UTC-4, Hans Hamm wrote:
On Thursday, November 1, 2012 1:31:33 PM UTC-4, Ben McClave wrote:

Hans,

I reworked this for you a bit. Rather than continue to layer procedures, I changed the sub to take arguments indicating (1) where the data resides in your workbook, (2) what range contains the information you want to summarize, (3) a string equivalent of this range to use in formulas, and (4) a formula string to make the SUMPRODUCT formula easier to work with.

At the top of the code is a Public variable called lStartRow. This value is initially set to 10 so that data begins to fill on row ten. Then, as the macros run, the lStartRow is adjusted to the next SECTION.

Finally, there is a macro called SummarizeData you can use to run each section. I included two potential sections of data for an example, but you can modify this routine to match your needs.

To use this, make your changes to the SummarizeData macro and then run it. that macro will call all of the others one at a time. Let me know if this works out OK for you.

Ben

Public lStartRow As Long

Sub SummarizeData()

Dim rData As Range 'Location of your data table

Dim sFrm As String 'SUMPRODUCT formula base

Application.ScreenUpdating = False

Sheet1.Rows("10:60000").ClearContents

Set rData = Sheet2.Range("A1:AJ2000")

sFrm = "=SUMPRODUCT((Sheet2!AJ$2:AJ$2000=Sheet1!C$1)*(Sh eet2!AJ$2:AJ$2000<=Sheet1!E$1)"

'First, get Team/Overall Data (takes formula base as only argument)

TeamData sFrm

'Next, get Store data (assumes stores in Sheet2, range H1:H2000)

lStartRow = 10 'Only need to set this once

GetDataDetails rData, Sheet2.Range("H1:H2000"), "Sheet2!H$2:H$2000", sFrm

'Now that Store is done, move to next item of interest (assumes data in Sheet2, range G1:G2000)

GetDataDetails rData, Sheet2.Range("G1:G2000"), "Sheet2!G$2:G$2000", sFrm

'Continue for any other details you need.

Application.ScreenUpdating = True

End Sub

Sub TeamData(sFormula As String)

'GETS OVERALL & TEAM DATA SECTION

With Sheet1.Range("B3")

.Formula = sFormula & ")"

.Value = .Value

End With

With Sheet1.Range("C3")

.Formula = sFormula & "*(Sheet2!G2:G2000=""Closed""))"

.Value = .Value

End With

With Sheet1.Range("D3")

.Formula = sFormula & "*(Sheet2!G2:G2000=""Pending""))"

.Value = .Value

End With

With Sheet1.Range("E3")

.Formula = sFormula & "*(Sheet2!G2:G2000=""Open""))"

.Value = .Value

End With

End Sub

Sub GetDataDetails(rDataRange As Range, rDetailRange As Range, sCompare As String, sForm As String)

'rDataRange is where your data is located

'rDetailRange is the range you wish to summarize (i.e. STORES, REASONS, etc.)

'sCompare is the string representing the range of values to lookup on sheet2 (i.e. Store names, Reason codes, etc.)

Dim wsNew As Worksheet 'New worksheet for data manipulation

Dim rCopy2 As Range 'Blank cell at the top of an unused column

Dim rDateCheck As Range 'Range of dates to check

Dim x As Long 'Used for cycling through the rCopy2 range

Dim y As Long 'Used for cycling through the rPaste range

Dim lastRow As Long 'Last row in column

Dim rPaste As Range 'First cell to receive the data

lastRow = Range(sCompare).Rows.Count + Range(sCompare).Range("A1").Row - 1

Set wsNew = Worksheets.Add

Set rDetailRange = rDetailRange.Resize(lastRow, rDetailRange.Columns.Count)

Set rDateCheck = Sheet2.Range("AJ2:AJ" & Sheet2.Range("AJ50000").End(xlUp).Row)

Set rPaste = Sheet1.Range("A" & lStartRow)

'Prepare criteria for the search

With wsNew

.Range("A1:B1").Value = rDateCheck.Offset(-1).Value

.Range("A2").FormulaR1C1 = "=""="" & Sheet1!R1C3"

.Range("B2").FormulaR1C1 = "=""<="" & Sheet1!R1C5"

.Range("A2:B2").Value = .Range("A2:B2").Value

Set rCopy2 = .Range("G1")

rCopy2.Value = rDetailRange.Value

rDataRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("A1:B2"), CopyToRange:=rCopy2, Unique:=True

End With

y = 0 'Set to zero to start

'Next, resize the rCopy2 range to match the rDetailRange range size

Set rCopy2 = rCopy2.Resize(wsNew.UsedRange.Rows.Count, 1)

'Now, cycle through each value in rCopy2 starting from the bottom _

and paste it to the final destination.

Dim lRows As Long

lRows = rCopy2.Rows.Count

For x = lRows To 2 Step -1

rPaste.Offset(y, 0).Value = rCopy2.Cells(x, 1)

y = y + 1 'Increment y to ensure next value goes into the cell below

Next x

'Finally, delete the wsNew sheet as it is no longer necessary.

Application.DisplayAlerts = False

wsNew.Delete

Application.DisplayAlerts = True

lRows = lStartRow + lRows - 2

With Sheet1.Range("B" & lStartRow & ":B" & lRows)

.Formula = sForm & "*(" & sCompare & "=Sheet1!A" & lStartRow & "))"

'.Value = .Value

End With

'Store Closed Calls

With Sheet1.Range("C" & lStartRow & ":C" & lRows)

.Formula = sForm & "*(" & sCompare & "=Sheet1!A" & lStartRow & ")*(Sheet2!G$2:G$2000=""Closed""))"

'.Value = .Value

End With

'Store Pending Calls

With Sheet1.Range("D" & lStartRow & ":D" & lRows)

.Formula = sForm & "*(" & sCompare & "=Sheet1!A" & lStartRow & ")*(Sheet2!G$2:G$2000=""Pending""))"

'.Value = .Value

End With

'Store Open Calls

With Sheet1.Range("E" & lStartRow & ":E" & lRows)

.Formula = sForm & "*(" & sCompare & "=Sheet1!A" & lStartRow & ")*(Sheet2!G$2:G$2000=""Open""))"

'.Value = .Value

End With

'Copies the data and pastes it two rows down

lStartRow = lRows + 3

End Sub

It seems to work even though I am almost clueless how you did this... give me a few days to digest and I will probably ask you a couple of questions.. I think I am fairly good with formulas, but VBA gives you so much more room for manipulation. That is why I have decided to go back and try to learn it. And you have given me a plate full to digest here. Ben I really appreciate your time and effort in working this out for me.

Ben,
Have a better grasp of this now (even though not 100%) but I am having an issue with sorting it. I have tried 3-4 different ways and it always stops with an error.

What I need is in CAPS in the last line(s) of code
'Copies the data and pastes it two rows down
lStartRow = lRows + 4
NEED TO SELECT THE DATA JUST PASTED (currently columns A:L) AND SORT ON COLUMN B HIGH TO LOW

Obviously there is something you have provided which I do not fully follow that is preventing me from doing this as I have recorded macros etc... and just cannot get it to run. The last macro I recorded is the following and I did try to manually re-write, but I am not following it
ActiveWindow.SmallScroll Down:=3
Range("A12:L26").Select
ActiveWorkbook.Worksheets("Sheet1").SORT.SortField s.Clear
ActiveWorkbook.Worksheets("Sheet1").SORT.SortField s.Add Key:=Range("B12:B26") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").SORT
.SetRange Range("A12:L26")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
I will say this it is working like a CHARM!

End Sub

Ben McClave

Bottom Up search for multiple entries

Hans,

I think I have a solution. First, add a line just above the CAPPED text in your last post so that it looks like this:

Call SortIt(lStartRow, lRows, Sheet1)
lStartRow = lRows + 4

This will call a new Sub to sort the data in the range A:L using column B for the rows we copied. Here is the Sub to perform the sort:

Sub SortIt(lFirstRow As Long, lLastRow As Long, ws As Worksheet)
With ws.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("B" & lFirstRow & ":B" & lLastRow) _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.SetRange Range("A" & lFirstRow & ":L" & lLastRow)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

The idea behind this is that since we know that the data falls into the columns A:L, with B as the sort column, and we also know the first and last rows of data (lStartRow and lRows, respectively), we can build the ranges used by the macro you recorded and make it more dynamic.

Hope this helps,

Ben

Hans Hamm

Bottom Up search for multiple entries

On Monday, November 12, 2012 9:04:10 AM UTC-5, Ben McClave wrote:
Hans,

I think I have a solution. First, add a line just above the CAPPED text in your last post so that it looks like this:

Call SortIt(lStartRow, lRows, Sheet1)

lStartRow = lRows + 4

This will call a new Sub to sort the data in the range A:L using column B for the rows we copied. Here is the Sub to perform the sort:

Sub SortIt(lFirstRow As Long, lLastRow As Long, ws As Worksheet)

With ws.Sort

.SortFields.Clear

.SortFields.Add Key:=Range("B" & lFirstRow & ":B" & lLastRow) _

, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

.SetRange Range("A" & lFirstRow & ":L" & lLastRow)

.Header = xlNo

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

End Sub

The idea behind this is that since we know that the data falls into the columns A:L, with B as the sort column, and we also know the first and last rows of data (lStartRow and lRows, respectively), we can build the ranges used by the macro you recorded and make it more dynamic.

Hope this helps,

Ben

PERFECTLY! I was close, but that is only good in horseshoes and hand grenades... THANKS!

Ben McClave

Bottom Up search for multiple entries

No problem, I'm happy to help.

Hans Hamm

Bottom Up search for multiple entries

On Monday, November 12, 2012 10:14:23 AM UTC-5, Ben McClave wrote:
No problem, I'm happy to help.

Okay Ben... everytime the bossman looks at it he wants a "new thing"
I need to add an additional sumproduct and would like to use your sFrm idea
You have written
sFrm = "=SUMPRODUCT((Sheet2!W$2:W$20000=Sheet1!C$1)*(She et2!W$2:W$20000<=Sheet1!E$1)"
And use this by calling sFormula & "*(Sheet2!L$2:L$20000=4)) or variations later.

I need this to run also sFrm2 = "=SUMPRODUCT((Sheet2!W:W<=Sheet1!E$1)*(Sheet2!W:W (Sheet1!E$1-21)"
What I have done so far is to try and duplicate the following
Dim sFrm As String .... with Dim SFrm2 As String
GetDataDetails rData, Sheet2.Range("R1:R20000"), "Sheet2!R$2:R$20000", sFrm .... with GetDataDetails rData, Sheet2.Range("R1:R20000"), "Sheet2!R$2:R$20000", sFrm2
etc... but I am missing something some where as I get error messages when I try to run it.

Ben McClave

Bottom Up search for multiple entries

Hans,

I think that it's because the SUMPRODUCT formula is looking for equal-sized ranges to compare. The rData range is from row 2 to row 2000, but the sFrm2 you used goes to row 20000. There are two ways to fix it. One is to resize the rData range with:

Set rData = Sheet2.Range("A1:AJ20000")

The other way is to change the sFrm2 formula to read:

sFrm2 = "=SUMPRODUCT((Sheet2!W$2:W$2000<=Sheet1!E$1)*(Shee t2!W$2:W$2000 Sheet1!E$1-21)"

Let me know if these options don't work out.

Ben

Hans Hamm

Bottom Up search for multiple entries

On Wednesday, November 14, 2012 3:08:55 PM UTC-5, Ben McClave wrote:
Hans,

I think that it's because the SUMPRODUCT formula is looking for equal-sized ranges to compare. The rData range is from row 2 to row 2000, but the sFrm2 you used goes to row 20000. There are two ways to fix it. One is to resize the rData range with:

Set rData = Sheet2.Range("A1:AJ20000")

The other way is to change the sFrm2 formula to read:

sFrm2 = "=SUMPRODUCT((Sheet2!W$2:W$2000<=Sheet1!E$1)*(Shee t2!W$2:W$2000 Sheet1!E$1-21)"

Let me know if these options don't work out.

Ben

Ben, that was a MAJOR DUH! Looked at everything else to see what I was doing wrong but NEVER even looked at that... I know better than that :(
That works fine, but of course leads to a new "not understanding". I apologize for hitting you up on this so much, but you have been a MAJOR help to me as I try to learn all of this.

So what I did was copied this from you
..Formula = sForm & "*(" & sCompare & "=Sheet1!A" & lStartRow & "))"
.Value = .Value
End With

And changed the sForm to sForm2 (which is: =SUMPRODUCT((Sheet2!W$2:W$20000<=Sheet1!E$1)*((She et2!W$2:W$20000Sheet1!E$1-21)/3)) but, the value I get in the cell is the last formula statement (which is; *(Sheet2!R$2:R$20000=Sheet1!A60))
Where/what am I missing here?

Hans Hamm

Bottom Up search for multiple entries

On Thursday, November 15, 2012 9:00:41 AM UTC-5, Hans Hamm wrote:
On Wednesday, November 14, 2012 3:08:55 PM UTC-5, Ben McClave wrote:

Hans,

I think that it's because the SUMPRODUCT formula is looking for equal-sized ranges to compare. The rData range is from row 2 to row 2000, but the sFrm2 you used goes to row 20000. There are two ways to fix it. One is to resize the rData range with:

Set rData = Sheet2.Range("A1:AJ20000")

The other way is to change the sFrm2 formula to read:

sFrm2 = "=SUMPRODUCT((Sheet2!W$2:W$2000<=Sheet1!E$1)*(Shee t2!W$2:W$2000 Sheet1!E$1-21)"

Let me know if these options don't work out.

Ben

Ben, that was a MAJOR DUH! Looked at everything else to see what I was doing wrong but NEVER even looked at that... I know better than that :(

That works fine, but of course leads to a new "not understanding". I apologize for hitting you up on this so much, but you have been a MAJOR help to me as I try to learn all of this.

So what I did was copied this from you

.Formula = sForm & "*(" & sCompare & "=Sheet1!A" & lStartRow & "))"

.Value = .Value

End With

And changed the sForm to sForm2 (which is: =SUMPRODUCT((Sheet2!W$2:W$20000<=Sheet1!E$1)*((She et2!W$2:W$20000Sheet1!E$1-21)/3)) but, the value I get in the cell is the last formula statement (which is; *(Sheet2!R$2:R$20000=Sheet1!A60))

Where/what am I missing here?

Ben got it to work using the following...With Sheet1.Range("C" & lStartRow & ":C" & lRows)

..Formula = "=SUMPRODUCT(((Sheet2!W$2:W$20000<=Sheet1!E$2)*(Sh eet2!W$2:W$20000=C$2)/H$2)*(" & sCompare & "=Sheet1!A" & lStartRow & "))"
..Value = .Value
End With
No idea why the other way would not though.

Hans Hamm

Bottom Up search for multiple entries

On Thursday, November 15, 2012 2:43:31 PM UTC-5, Hans Hamm wrote:
On Thursday, November 15, 2012 9:00:41 AM UTC-5, Hans Hamm wrote:

On Wednesday, November 14, 2012 3:08:55 PM UTC-5, Ben McClave wrote:

Hans,

I think that it's because the SUMPRODUCT formula is looking for equal-sized ranges to compare. The rData range is from row 2 to row 2000, but the sFrm2 you used goes to row 20000. There are two ways to fix it. One is to resize the rData range with:

Set rData = Sheet2.Range("A1:AJ20000")

The other way is to change the sFrm2 formula to read:

sFrm2 = "=SUMPRODUCT((Sheet2!W$2:W$2000<=Sheet1!E$1)*(Shee t2!W$2:W$2000 Sheet1!E$1-21)"

Let me know if these options don't work out.

Ben

Ben, that was a MAJOR DUH! Looked at everything else to see what I was doing wrong but NEVER even looked at that... I know better than that :(

That works fine, but of course leads to a new "not understanding". I apologize for hitting you up on this so much, but you have been a MAJOR help to me as I try to learn all of this.

So what I did was copied this from you

.Formula = sForm & "*(" & sCompare & "=Sheet1!A" & lStartRow & "))"

.Value = .Value

End With

And changed the sForm to sForm2 (which is: =SUMPRODUCT((Sheet2!W$2:W$20000<=Sheet1!E$1)*((She et2!W$2:W$20000Sheet1!E$1-21)/3)) but, the value I get in the cell is the last formula statement (which is; *(Sheet2!R$2:R$20000=Sheet1!A60))

Where/what am I missing here?

Ben got it to work using the following...With Sheet1.Range("C" & lStartRow & ":C" & lRows)

.Formula = "=SUMPRODUCT(((Sheet2!W$2:W$20000<=Sheet1!E$2)*(Sh eet2!W$2:W$20000=C$2)/H$2)*(" & sCompare & "=Sheet1!A" & lStartRow & "))"

.Value = .Value

End With

No idea why the other way would not though.

Ben not sure you will see this... now onto a sheet and I basically copied all the code you provided to at the very beginning of this long conversation.. But now instead of using Sheet1 to report everything I am using Sheet6... went thru and looked for any reference to Sheet1 and changed to Sheet6. Not getting an error, but data is not being pasted (I assume). This sheet is for a different range of dates and looks for different data to summarize. This is what I have changed would you take a look and see where I am missing this at?
Public lStartRow As Long
Sub RUNWeeks_Click()
Dim rData As Range 'Location of your data table
Dim sFrm As String 'SUMPRODUCT formula base
Dim sFrm2 As String 'AVERAGEIFS for Attempts

Application.ScreenUpdating = False

'Sheet1.Rows("23:60000").ClearContents
Set rData = Sheet2.Range("A1:AJ20000")
sFrm = "=SUMPRODUCT((Sheet2!$W$2:$W$20000<=Sheet6!$G$1)*( Sheet2!$W$2:$W$20000=Sheet6!$D$18)"
'sFrm2 = "=SUMPRODUCT(((Sheet2!W$2:W$20000<=Sheet1!E$2)*(Sh eet2!W$2:W$20000=C$2)/H$2)"

'First, get Team/Overall Data (takes formula base as only argument)
TeamData sFrm, sFrm2

'Next, get Store data (assumes stores in Sheet2, range H1:H2000)
lStartRow = 46 'Only need to set this once
GetDataDetails rData, Sheet2.Range("R1:R20000"), "Sheet2!R$2:R$20000", sFrm

'Now that Store is done, move to next item of interest (assumes data in Sheet2, range G1:G2000)
GetDataDetails rData, Sheet2.Range("H1:H20000"), "Sheet2!H$2:H$20000", sFrm
GetDataDetails rData, Sheet2.Range("O1:O20000"), "Sheet2!O$2:O$20000", sFrm
GetDataDetails rData, Sheet2.Range("B1:B20000"), "Sheet2!B$2:B$20000", sFrm
GetDataDetails rData, Sheet2.Range("C1:C20000"), "Sheet2!C$2:C$20000", sFrm

'Continue for any other details you need.

'Application.ScreenUpdating = True
End Sub
Sub GetDataDetails(rDataRange As Range, rDetailRange As Range, sCompare As String, sForm As String)
'rDataRange is where your data is located
'rDetailRange is the range you wish to summarize (i.e. STORES, REASONS, etc..)
'sCompare is the string representing the range of values to lookup on sheet2 (i.e. Store names, Reason codes, etc.)

Dim wsNew As Worksheet 'New worksheet for data manipulation
Dim rCopy2 As Range 'Blank cell at the top of an unused column
Dim rDateCheck As Range 'Range of dates to check

Dim x As Long 'Used for cycling through the rCopy2 range
Dim y As Long 'Used for cycling through the rPaste range

Dim lastRow As Long 'Last row in column
Dim rPaste As Range 'First cell to receive the data

lastRow = Range(sCompare).Rows.Count + Range(sCompare).Range("A1").Row - 1
Set wsNew = Worksheets.Add
Set rDetailRange = rDetailRange.Resize(lastRow, rDetailRange.Columns.Count)
Set rDateCheck = Sheet2.Range("W2:W" & Sheet2.Range("W50000").End(xlUp).Row)
Set rPaste = Sheet6.Range("A" & lStartRow)

'Prepare criteria for the search
With wsNew
.Range("A1:B1").Value = rDateCheck.Offset(-1).Value
.Range("A2").FormulaR1C1 = "=""="" & Sheet6!R18C4"
.Range("B2").FormulaR1C1 = "=""<="" & Sheet6!R18C5"
.Range("A2:B2").Value = .Range("A2:B2").Value
Set rCopy2 = .Range("G1")
rCopy2.Value = rDetailRange.Value
rDataRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=..Range("A1:B2"), CopyToRange:=rCopy2, Unique:=True
End With

y = 0 'Set to zero to start

'Next, resize the rCopy2 range to match the rDetailRange range size

Set rCopy2 = rCopy2.Resize(wsNew.UsedRange.Rows.Count, 1)

'Now, cycle through each value in rCopy2 starting from the bottom _
and paste it to the final destination.

Dim lRows As Long
lRows = rCopy2.Rows.Count
For x = lRows To 2 Step -1

rPaste.Offset(y, 0).Value = rCopy2.Cells(x, 1)

y = y + 1 'Increment y to ensure next value goes into the cell below
Next x

'Finally, delete the wsNew sheet as it is no longer necessary.
Application.DisplayAlerts = False
wsNew.Delete
Application.DisplayAlerts = True

lRows = lStartRow + lRows - 2
With Sheet6.Range("D" & lStartRow & ":D" & lRows)

..Formula = sForm & "*(" & sCompare & "=Sheet1!A" & lStartRow & "))"
.Value = .Value
End With

End Sub

I thank you ALOT!!!

Ben McClave

Bottom Up search for multiple entries

Hans,

I think that there were a few little things that added up to the formulas not working. I reworked your code under the assumption that the start date is located at Sheet6!$D$18 and the end date is Sheet6!$E$18. Also, the third line from the bottom still referenced Sheet1. I also included a line to turn screen updating back on and to insert two lines before summarizing the next section. Best of luck with this.

Ben

Public lStartRow As Long
Sub RUNWeeks_Click()
Dim rData As Range 'Location of your data table
Dim sFrm As String 'SUMPRODUCT formula base
Dim sFrm2 As String 'AVERAGEIFS for Attempts

Application.ScreenUpdating = False

Sheet6.Rows("46:60000").ClearContents

Set rData = Sheet2.Range("A1:AJ20000")

sFrm = "=SUMPRODUCT((Sheet2!$W$2:$W$20000<=Sheet6!$E$18)* (Sheet2!$W$2:$W$20000=Sheet6!$D$18)"

lStartRow = 46 'Only need to set this once
GetDataDetails rData, Sheet2.Range("R1:R20000"), "Sheet2!R$2:R$20000", sFrm
GetDataDetails rData, Sheet2.Range("H1:H20000"), "Sheet2!H$2:H$20000", sFrm
GetDataDetails rData, Sheet2.Range("O1:O20000"), "Sheet2!O$2:O$20000", sFrm
GetDataDetails rData, Sheet2.Range("B1:B20000"), "Sheet2!B$2:B$20000", sFrm
GetDataDetails rData, Sheet2.Range("C1:C20000"), "Sheet2!C$2:C$20000", sFrm

Application.ScreenUpdating = True

End Sub

Sub GetDataDetails(rDataRange As Range, rDetailRange As Range, sCompare As String, sForm As String)
'rDataRange is where your data is located
'rDetailRange is the range you wish to summarize (i.e. STORES, REASONS, etc.)
'sCompare is the string representing the range of values to lookup on sheet2 (i.e. Store names, Reason codes, etc.)

Dim wsNew As Worksheet 'New worksheet for data manipulation
Dim rCopy2 As Range 'Blank cell at the top of an unused column
Dim rDateCheck As Range 'Range of dates to check

Dim x As Long 'Used for cycling through the rCopy2 range
Dim y As Long 'Used for cycling through the rPaste range

Dim lastRow As Long 'Last row in column
Dim rPaste As Range 'First cell to receive the data

lastRow = Range(sCompare).Rows.Count + Range(sCompare).Range("A1").Row - 1
Set wsNew = Worksheets.Add
Set rDetailRange = rDetailRange.Resize(lastRow, rDetailRange.Columns.Count)
Set rDateCheck = Sheet2.Range("W2:W" & Sheet2.Range("W50000").End(xlUp).Row)
Set rPaste = Sheet6.Range("A" & lStartRow)

'Prepare criteria for the search
With wsNew
.Range("A1:B1").Value = rDateCheck.Offset(-1).Value

'HANS: Check next two lines to ensure correct date fields are shown
.Range("A2").FormulaR1C1 = "=""="" & Sheet6!R18C4" 'R18C4 = "$D$18"
.Range("B2").FormulaR1C1 = "=""<="" & Sheet6!R18C5" 'R18C5 = "$E$18"

.Range("A2:B2").Value = .Range("A2:B2").Value
Set rCopy2 = .Range("G1")
rCopy2.Value = rDetailRange.Value
rDataRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=..Range("A1:B2"), CopyToRange:=rCopy2, Unique:=True
End With

y = 0 'Set to zero to start

'Next, resize the rCopy2 range to match the rDetailRange range size

Set rCopy2 = rCopy2.Resize(wsNew.UsedRange.Rows.Count, 1)

'Now, cycle through each value in rCopy2 starting from the bottom _
and paste it to the final destination.

Dim lRows As Long
lRows = rCopy2.Rows.Count
For x = lRows To 2 Step -1

rPaste.Offset(y, 0).Value = rCopy2.Cells(x, 1)

y = y + 1 'Increment y to ensure next value goes into the cell below
Next x

'Finally, delete the wsNew sheet as it is no longer necessary.
Application.DisplayAlerts = False
wsNew.Delete
Application.DisplayAlerts = True

lRows = lStartRow + lRows - 2

With Sheet6.Range("D" & lStartRow & ":D" & lRows)
.Formula = sForm & "*(" & sCompare & "=Sheet6!A" & lStartRow & "))"
.Value = .Value
End With

lStartRow = lRows + 3

End Sub

Hans Hamm

Bottom Up search for multiple entries

On Friday, November 16, 2012 9:53:23 AM UTC-5, Ben McClave wrote:
Hans,

I think that there were a few little things that added up to the formulas not working. I reworked your code under the assumption that the start date is located at Sheet6!$D$18 and the end date is Sheet6!$E$18. Also, the third line from the bottom still referenced Sheet1. I also included a line to turn screen updating back on and to insert two lines before summarizing the next section. Best of luck with this.

Ben

Public lStartRow As Long

Sub RUNWeeks_Click()

Dim rData As Range 'Location of your data table

Dim sFrm As String 'SUMPRODUCT formula base

Dim sFrm2 As String 'AVERAGEIFS for Attempts

Application.ScreenUpdating = False

Sheet6.Rows("46:60000").ClearContents

Set rData = Sheet2.Range("A1:AJ20000")

sFrm = "=SUMPRODUCT((Sheet2!$W$2:$W$20000<=Sheet6!$E$18)* (Sheet2!$W$2:$W$20000=Sheet6!$D$18)"

lStartRow = 46 'Only need to set this once

GetDataDetails rData, Sheet2.Range("R1:R20000"), "Sheet2!R$2:R$20000", sFrm

GetDataDetails rData, Sheet2.Range("H1:H20000"), "Sheet2!H$2:H$20000", sFrm

GetDataDetails rData, Sheet2.Range("O1:O20000"), "Sheet2!O$2:O$20000", sFrm

GetDataDetails rData, Sheet2.Range("B1:B20000"), "Sheet2!B$2:B$20000", sFrm

GetDataDetails rData, Sheet2.Range("C1:C20000"), "Sheet2!C$2:C$20000", sFrm

Application.ScreenUpdating = True

End Sub

Sub GetDataDetails(rDataRange As Range, rDetailRange As Range, sCompare As String, sForm As String)

'rDataRange is where your data is located

'rDetailRange is the range you wish to summarize (i.e. STORES, REASONS, etc.)

'sCompare is the string representing the range of values to lookup on sheet2 (i.e. Store names, Reason codes, etc.)

Dim wsNew As Worksheet 'New worksheet for data manipulation

Dim rCopy2 As Range 'Blank cell at the top of an unused column

Dim rDateCheck As Range 'Range of dates to check

Dim x As Long 'Used for cycling through the rCopy2 range

Dim y As Long 'Used for cycling through the rPaste range

Dim lastRow As Long 'Last row in column

Dim rPaste As Range 'First cell to receive the data

lastRow = Range(sCompare).Rows.Count + Range(sCompare).Range("A1").Row - 1

Set wsNew = Worksheets.Add

Set rDetailRange = rDetailRange.Resize(lastRow, rDetailRange.Columns.Count)

Set rDateCheck = Sheet2.Range("W2:W" & Sheet2.Range("W50000").End(xlUp).Row)

Set rPaste = Sheet6.Range("A" & lStartRow)

'Prepare criteria for the search

With wsNew

.Range("A1:B1").Value = rDateCheck.Offset(-1).Value

'HANS: Check next two lines to ensure correct date fields are shown

.Range("A2").FormulaR1C1 = "=""="" & Sheet6!R18C4" 'R18C4 = "$D$18"

.Range("B2").FormulaR1C1 = "=""<="" & Sheet6!R18C5" 'R18C5 = "$E$18"

.Range("A2:B2").Value = .Range("A2:B2").Value

Set rCopy2 = .Range("G1")

rCopy2.Value = rDetailRange.Value

rDataRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("A1:B2"), CopyToRange:=rCopy2, Unique:=True

End With

y = 0 'Set to zero to start

'Next, resize the rCopy2 range to match the rDetailRange range size

Set rCopy2 = rCopy2.Resize(wsNew.UsedRange.Rows.Count, 1)

'Now, cycle through each value in rCopy2 starting from the bottom _

and paste it to the final destination.

Dim lRows As Long

lRows = rCopy2.Rows.Count

For x = lRows To 2 Step -1

rPaste.Offset(y, 0).Value = rCopy2.Cells(x, 1)

y = y + 1 'Increment y to ensure next value goes into the cell below

Next x

'Finally, delete the wsNew sheet as it is no longer necessary.

Application.DisplayAlerts = False

wsNew.Delete

Application.DisplayAlerts = True

lRows = lStartRow + lRows - 2

With Sheet6.Range("D" & lStartRow & ":D" & lRows)

.Formula = sForm & "*(" & sCompare & "=Sheet6!A" & lStartRow & "))"

.Value = .Value

End With

lStartRow = lRows + 3

End Sub

Ben you made one point and I had a major duh moment, I was not seeing this all the way through... got it working. I hope this is the end of this thread and I can move onto "new understandings of VBA". I really appreciate your assistance and patience.
Hans

Hans Hamm

Bottom Up search for multiple entries

On Friday, November 16, 2012 4:45:37 PM UTC-5, Hans Hamm wrote:
On Friday, November 16, 2012 9:53:23 AM UTC-5, Ben McClave wrote:

Hans,

I think that there were a few little things that added up to the formulas not working. I reworked your code under the assumption that the start date is located at Sheet6!$D$18 and the end date is Sheet6!$E$18. Also, the third line from the bottom still referenced Sheet1. I also included a line to turn screen updating back on and to insert two lines before summarizing the next section. Best of luck with this.

Ben

Public lStartRow As Long

Sub RUNWeeks_Click()

Dim rData As Range 'Location of your data table

Dim sFrm As String 'SUMPRODUCT formula base

Dim sFrm2 As String 'AVERAGEIFS for Attempts

Application.ScreenUpdating = False

Sheet6.Rows("46:60000").ClearContents

Set rData = Sheet2.Range("A1:AJ20000")

sFrm = "=SUMPRODUCT((Sheet2!$W$2:$W$20000<=Sheet6!$E$18)* (Sheet2!$W$2:$W$20000=Sheet6!$D$18)"

lStartRow = 46 'Only need to set this once

GetDataDetails rData, Sheet2.Range("R1:R20000"), "Sheet2!R$2:R$20000", sFrm

GetDataDetails rData, Sheet2.Range("H1:H20000"), "Sheet2!H$2:H$20000", sFrm

GetDataDetails rData, Sheet2.Range("O1:O20000"), "Sheet2!O$2:O$20000", sFrm

GetDataDetails rData, Sheet2.Range("B1:B20000"), "Sheet2!B$2:B$20000", sFrm

GetDataDetails rData, Sheet2.Range("C1:C20000"), "Sheet2!C$2:C$20000", sFrm

Application.ScreenUpdating = True

End Sub

Sub GetDataDetails(rDataRange As Range, rDetailRange As Range, sCompare As String, sForm As String)

'rDataRange is where your data is located

'rDetailRange is the range you wish to summarize (i.e. STORES, REASONS, etc.)

'sCompare is the string representing the range of values to lookup on sheet2 (i.e. Store names, Reason codes, etc.)

Dim wsNew As Worksheet 'New worksheet for data manipulation

Dim rCopy2 As Range 'Blank cell at the top of an unused column

Dim rDateCheck As Range 'Range of dates to check

Dim x As Long 'Used for cycling through the rCopy2 range

Dim y As Long 'Used for cycling through the rPaste range

Dim lastRow As Long 'Last row in column

Dim rPaste As Range 'First cell to receive the data

lastRow = Range(sCompare).Rows.Count + Range(sCompare).Range("A1").Row - 1

Set wsNew = Worksheets.Add

Set rDetailRange = rDetailRange.Resize(lastRow, rDetailRange.Columns.Count)

Set rDateCheck = Sheet2.Range("W2:W" & Sheet2.Range("W50000").End(xlUp).Row)

Set rPaste = Sheet6.Range("A" & lStartRow)

'Prepare criteria for the search

With wsNew

.Range("A1:B1").Value = rDateCheck.Offset(-1).Value

'HANS: Check next two lines to ensure correct date fields are shown

.Range("A2").FormulaR1C1 = "=""="" & Sheet6!R18C4" 'R18C4 = "$D$18"

.Range("B2").FormulaR1C1 = "=""<="" & Sheet6!R18C5" 'R18C5 = "$E$18"

.Range("A2:B2").Value = .Range("A2:B2").Value

Set rCopy2 = .Range("G1")

rCopy2.Value = rDetailRange.Value

rDataRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("A1:B2"), CopyToRange:=rCopy2, Unique:=True

End With

y = 0 'Set to zero to start

'Next, resize the rCopy2 range to match the rDetailRange range size

Set rCopy2 = rCopy2.Resize(wsNew.UsedRange.Rows.Count, 1)

'Now, cycle through each value in rCopy2 starting from the bottom _

and paste it to the final destination.

Dim lRows As Long

lRows = rCopy2.Rows.Count

For x = lRows To 2 Step -1

rPaste.Offset(y, 0).Value = rCopy2.Cells(x, 1)

y = y + 1 'Increment y to ensure next value goes into the cell below

Next x

'Finally, delete the wsNew sheet as it is no longer necessary.

Application.DisplayAlerts = False

wsNew.Delete

Application.DisplayAlerts = True

lRows = lStartRow + lRows - 2

With Sheet6.Range("D" & lStartRow & ":D" & lRows)

.Formula = sForm & "*(" & sCompare & "=Sheet6!A" & lStartRow & "))"

.Value = .Value

End With

lStartRow = lRows + 3

End Sub

Ben you made one point and I had a major duh moment, I was not seeing this all the way through... got it working. I hope this is the end of this thread and I can move onto "new understandings of VBA". I really appreciate your assistance and patience.

Hans

Hey Ben it is really working great! Made a few tweeks here and there, but I have one I cannot get working very well. Wondering if you can pinch hit one more time. When each "section" is complete I need to have an averageifs formula in Column L... tried numerous ideas, but to no avail. It would look something like this
With Sheet1.Range("L"&lStartRow&":L" & lRows)
..Formula = "=AVERAGEIFS(Sheet2!E:E,Sheet2!W:W,"" = ""&Sheet1!C$1,Sheet2!W:W,"" <= ""&Sheet1!E$1,(" & sCompare & "=Sheet1!A" & lStartRow & ")"
.Value = .Value
End With

Ben McClave

Bottom Up search for multiple entries

Hans,

I think that there may have been an extra open parenthesis or an errant comma somewhere. This formula seems to get the basic structure to work:

..Formula = "=AVERAGEIFS(Sheet2!E:E,Sheet2!W:W,""="" & Sheet1!C$1,Sheet2!W:W,""<="" & Sheet1!E$1, " & sCompare & ", Sheet1!A" & lStartRow & ")"

If it still doesn't work, you might try using

Debug.Print "=AVERAGEIFS(Sheet2!E:E,Sheet2!W:W,""="" & Sheet1!C$1,Sheet2!W:W,""<="" & Sheet1!E$1, " & sCompare & ", Sheet1!A" & lStartRow & ")"

to have the formula print in the VBA module Immediate Window. Then, copy the formula to a cell on your worksheet to see what piece(s) cause an issue.

Hans Hamm

Bottom Up search for multiple entries

On Monday, November 26, 2012 2:12:35 PM UTC-5, Ben McClave wrote:
Hans,

I think that there may have been an extra open parenthesis or an errant comma somewhere. This formula seems to get the basic structure to work:

.Formula = "=AVERAGEIFS(Sheet2!E:E,Sheet2!W:W,""="" & Sheet1!C$1,Sheet2!W:W,""<="" & Sheet1!E$1, " & sCompare & ", Sheet1!A" & lStartRow & ")"

If it still doesn't work, you might try using

Debug.Print "=AVERAGEIFS(Sheet2!E:E,Sheet2!W:W,""="" & Sheet1!C$1,Sheet2!W:W,""<="" & Sheet1!E$1, " & sCompare & ", Sheet1!A" & lStartRow & ")"

to have the formula print in the VBA module Immediate Window. Then, copy the formula to a cell on your worksheet to see what piece(s) cause an issue.

That's strange I do not remember having to "set the range" ie $W$2:$W$20000, now doing that it worked kind of... I commented out the .Value=.Value so I could see the formula. This is in Cell L60 and I do get a value now...
=AVERAGEIFS(Sheet2!E$2:E$20000,Sheet2!W$2:W$20000, "="&Sheet1!C$1,Sheet2!W$2:W$20000,"<="&Sheet1!E$1 ,Sheet2!R$2:R$20000,Sheet1!A68)
But if you notice it is referring to cell A68 and not A60
It is very random of where it is pointing to in column A
I went back and tried the " & sCompare & "=Sheet1!A" & lStartRow & ") at the end, but come back with a 1004 runtime error

Hans Hamm

Bottom Up search for multiple entries

On Monday, November 26, 2012 4:31:05 PM UTC-5, Hans Hamm wrote:
On Monday, November 26, 2012 2:12:35 PM UTC-5, Ben McClave wrote:

Hans,

I think that there may have been an extra open parenthesis or an errant comma somewhere. This formula seems to get the basic structure to work:

.Formula = "=AVERAGEIFS(Sheet2!E:E,Sheet2!W:W,""="" & Sheet1!C$1,Sheet2!W:W,""<="" & Sheet1!E$1, " & sCompare & ", Sheet1!A" & lStartRow & ")"

If it still doesn't work, you might try using

Debug.Print "=AVERAGEIFS(Sheet2!E:E,Sheet2!W:W,""="" & Sheet1!C$1,Sheet2!W:W,""<="" & Sheet1!E$1, " & sCompare & ", Sheet1!A" & lStartRow & ")"

to have the formula print in the VBA module Immediate Window. Then, copy the formula to a cell on your worksheet to see what piece(s) cause an issue.

That's strange I do not remember having to "set the range" ie $W$2:$W$20000, now doing that it worked kind of... I commented out the .Value=.Value so I could see the formula. This is in Cell L60 and I do get a value now....

=AVERAGEIFS(Sheet2!E$2:E$20000,Sheet2!W$2:W$20000, "="&Sheet1!C$1,Sheet2!W$2:W$20000,"<="&Sheet1!E$1 ,Sheet2!R$2:R$20000,Sheet1!A68)

But if you notice it is referring to cell A68 and not A60

It is very random of where it is pointing to in column A

I went back and tried the " & sCompare & "=Sheet1!A" & lStartRow & ") at the end, but come back with a 1004 runtime error

Ben... Had to work on some other projects for awhile, but it is kind of odd.. When I came back to this last week. It worked dead on, have no idea what it was. But it works. This report is now live and being sent to Corp. I appreciate all of your help and guidance! This posting works and I consider it "closed down"

Ben McClave

Bottom Up search for multiple entries

Hans,

That's great news. I'm happy to help.

Best of luck,

Ben

Hans Hamm

Bottom Up search for multiple entries

On Monday, December 10, 2012 8:06:55 AM UTC-5, Ben McClave wrote:
Hans,

That's great news. I'm happy to help.

Best of luck,

Ben... one additional thing has come up, that I did not anticipate. Through this long process of looking up the data, copying and pasting etc... I want to exclude any "Blanks" from the Data? It is causing some minor issues when I start the charting process.
As I stated much much earlier, I am not a guru at this.
I am assuming it would be best to place something like this here;
If
GetDataDetails rData, Sheet2.Range("C1:C20000"), "Sheet2!C$2:C$20000", sFrm
Then ""
If Not
GetDataDetails rData, Sheet2.Range("C1:C20000"), "Sheet2!C$2:C$20000", sFrm

Thanks again!

Ben McClave

Bottom Up search for multiple entries

Hans,

I'm not quite sure that I follow the question. Are you looking to skip the GetDataDetails function whenever there is no data in a certain range? If so, you could add a line such as this to your project:

If WorksheetFunction.CountA(myRange) 0 Then _
GetDataDetails rData, Sheet2.Range("C1:C20000"), "Sheet2!C$2:C$20000", sFrm

Just change the "myRange" part to whatever range may include blank values. The fucntion will use Excel's COUNTA function to count all non-blank cells in the range. If all cells are blank, the COUNTA will return 0. So the If..Then function above will only run the GetDataDetails function when the range you check includes at least one non-blank cell.

Hope this helps,

Ben

Hans Hamm

Bottom Up search for multiple entries

On Wednesday, December 12, 2012 12:40:35 PM UTC-5, Ben McClave wrote:
Hans,

I'm not quite sure that I follow the question. Are you looking to skip the GetDataDetails function whenever there is no data in a certain range? If so, you could add a line such as this to your project:

If WorksheetFunction.CountA(myRange) 0 Then _

GetDataDetails rData, Sheet2.Range("C1:C20000"), "Sheet2!C$2:C$20000", sFrm

Just change the "myRange" part to whatever range may include blank values.. The fucntion will use Excel's COUNTA function to count all non-blank cells in the range. If all cells are blank, the COUNTA will return 0. So the If..Then function above will only run the GetDataDetails function when the range you check includes at least one non-blank cell.

Hope this helps,

Ben

Ben, for someone not following the question... you were dead on. That is exactly what I am trying to do.
I copied what you provided and put in the range, so it is this:
If WorksheetFunction.CountA(Sheet2.Range("C1:C20000") ) 0 Then _
GetDataDetails rData, Sheet2.Range("C1:C20000"), "Sheet2!C$2:C$20000", sFrm
But I am still getting the data that I do not want.
Also tried the WorksheetFunction.IsText etc... and either got an error message or returning the data.
This is where I am real weak at VBA

I appreciate this again!

Ben McClave

Bottom Up search for multiple entries

Hans,

My best guess as to what's happening here is that you have a column heading in cell C1 that is causing the COUNTA to return a value of 1. If that is the case, you could change the range to start at C2 or change the If..Then function to look for values 1. Here are examples of each option:

If WorksheetFunction.CountA(Sheet2.Range("C2:C20000") ) 0 Then _
GetDataDetails rData, Sheet2.Range("C1:C20000"), "Sheet2!C$2:C$20000", sFrm

OR

If WorksheetFunction.CountA(Sheet2.Range("C1:C20000") ) 1 Then _
GetDataDetails rData, Sheet2.Range("C1:C20000"), "Sheet2!C$2:C$20000", sFrm

A different alternative would be to make a tweak to the the GetDataDetails function to check for zero-length strings. In this case you would change the line:

rPaste.Offset(y, 0).Value = rCopy2.Cells(x, 1)

(which is near the end of the function) to this:

If Len(rCopy2.Cells(x, 1).Value) 0 Then rPaste.Offset(y, 0).Value = rCopy2.Cells(x, 1)

Let me know if any of these suggestions work out.

Ben

Hans Hamm

Bottom Up search for multiple entries

On Wednesday, December 12, 2012 2:39:05 PM UTC-5, Ben McClave wrote:
Hans,

My best guess as to what's happening here is that you have a column heading in cell C1 that is causing the COUNTA to return a value of 1. If that is the case, you could change the range to start at C2 or change the If..Then function to look for values 1. Here are examples of each option:

If WorksheetFunction.CountA(Sheet2.Range("C2:C20000") ) 0 Then _

GetDataDetails rData, Sheet2.Range("C1:C20000"), "Sheet2!C$2:C$20000", sFrm

OR

If WorksheetFunction.CountA(Sheet2.Range("C1:C20000") ) 1 Then _

GetDataDetails rData, Sheet2.Range("C1:C20000"), "Sheet2!C$2:C$20000", sFrm

A different alternative would be to make a tweak to the the GetDataDetails function to check for zero-length strings. In this case you would change the line:

rPaste.Offset(y, 0).Value = rCopy2.Cells(x, 1)

(which is near the end of the function) to this:

If Len(rCopy2.Cells(x, 1).Value) 0 Then rPaste.Offset(y, 0).Value = rCopy2.Cells(x, 1)

Let me know if any of these suggestions work out.

Ben

Ben
I set a breakpoint so I could see the data coming from Sheet 2 Column C and being pasted into the new sheet. Each variation is copying and pasting the blank cell.
How would I do something like this; If rpaste.Offset(y,0).Value <"" then rPaste.Offset(y, 0).Value = rCopy2.Cells(x, 1)
I tried this and did not get it to work... to me it seems like it would.

All times are GMT +1. The time now is 12:38 PM.

Page 1 of 2

Show 40 post(s) from this thread on one page