Bottom Up search for multiple entries

B

Ben McClave

Hans,

I think I have a solution. First, add a line just above the CAPPED text inyour 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
 
H

Hans Hamm

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 Bfor 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
Click to expand...

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

Hans Hamm

No problem, I'm happy to help.
Click to expand...

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)*(Sheet2!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.
 
B

Ben McClave

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)*(Sheet2!W$2:W$2000 > Sheet1!E$1-21)"

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

Ben
 
H

Hans Hamm

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)*(Sheet2!W$2:W$2000 > Sheet1!E$1-21)"



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



Ben
Click to expand...

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)*((Sheet2!W$2:W$20000>Sheet1!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?
 
H

Hans Hamm

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)*((Sheet2!W$2:W$20000>Sheet1!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?
Click to expand...

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)*(Sheet2!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.
 
H

Hans Hamm

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)*(Sheet2!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.
Click to expand...

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 missingthis 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)*(Sheet2!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!!!
 
B

Ben McClave

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 toturn 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
 
H

Hans Hamm

Hans,



I think that there were a few little things that added up to the formulasnot 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 onsheet2 (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
Click to expand...

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 yourassistance and patience.
Hans
 
H

Hans Hamm

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
Click to expand...

Hey Ben it is really working great! Made a few tweeks here and there, but Ihave 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
 
B

Ben McClave

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.
 
H

Hans Hamm

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.
Click to expand...

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
 
H

Hans Hamm

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=.Valueso 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
Click to expand...

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"
 
H

Hans Hamm

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.
Click to expand...
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!
 
B

Ben McClave

Hans,

I'm not quite sure that I follow the question. Are you looking to skip theGetDataDetails 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 cellsin 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
 
H

Hans Hamm

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 theIf..Then function above will only run the GetDataDetails function when therange you check includes at least one non-blank cell.



Hope this helps,



Ben
Click to expand...


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!
 
B

Ben McClave

Hans,

My best guess as to what's happening here is that you have a column headingin 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
 
H

Hans Hamm

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 changethe 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
Click to expand...

Ben
I set a breakpoint so I could see the data coming from Sheet 2 Column C andbeing pasted into the new sheet. Each variation is copying and pasting theblank 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.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA for data validation in 3rd column does not run. I need help. 1
Create if partial match then copy and paste data from one cell to another 1
Find and Replace 6
Macro to Combine Data from Multiple Sheets with Cell References 4
Search other sheets for numbers & color them 10
Look Up Formula With Veried Search Range 2
Search the list of Ids in the records 1
Auto concantenate 1

Top