Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
urgent - changing a range
Hi,
A bit urgent - Does anyone know why this isn`t working? The code is to do an advanced filter taking the full range of data in a worksheet? If possible, I`d like to alter it to put the results of the filter in a new sheet. Thanks. Dave "source data" - the main file which is being filtered from. "criteria file" - the criteria for the filter Dim rngData As Range, RngCrit As Range Dim rngOutput As Range With ActiveWorkbook With .Sheets("source data") Set rngData = .Range("A1").CurrentRegion ' End With With .Sheets("criteria file") Set RngCrit = .Range("A1").CurrentRegion ' Set rngOutput = .Range("A1") End With .Sheets("criteria file").Activate rngData.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=RngCrit, _ CopyToRange:=rngOutput, _ Unique:=True End With *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
urgent - changing a range
Hi David,
Setting your criteria range to: Set RngCrit = .Range("A1").CurrentRegion ' means that the filter criteria will be overwritten by your extracted data. You should, therefore move the criteria range away from your output range. Additionally, you should clear your output range between filter operations. Using H1 on the criteria file sheet as the anchor cell for the criteria range, your code might read as: Sub Tester() Dim rngData As Range, RngCrit As Range Dim rngOutput As Range With ActiveWorkbook With .Sheets("source data") Set rngData = .Range("A1").CurrentRegion ' End With With .Sheets("criteria file") Set RngCrit = .Range("H1").CurrentRegion ' Set rngOutput = .Range("A1") End With .Sheets("criteria file").Activate rngOutput.CurrentRegion.ClearContents rngData.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=RngCrit, _ CopyToRange:=rngOutput, _ Unique:=True End With End Sub Change H1 to a convenient location non-contiguous to the output range. --- Regards, Norman "david shapiro" wrote in message ... Hi, A bit urgent - Does anyone know why this isn`t working? The code is to do an advanced filter taking the full range of data in a worksheet? If possible, I`d like to alter it to put the results of the filter in a new sheet. Thanks. Dave "source data" - the main file which is being filtered from. "criteria file" - the criteria for the filter Dim rngData As Range, RngCrit As Range Dim rngOutput As Range With ActiveWorkbook With .Sheets("source data") Set rngData = .Range("A1").CurrentRegion ' End With With .Sheets("criteria file") Set RngCrit = .Range("A1").CurrentRegion ' Set rngOutput = .Range("A1") End With .Sheets("criteria file").Activate rngData.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=RngCrit, _ CopyToRange:=rngOutput, _ Unique:=True End With *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
urgent - changing a range
Norman and others, Thanks for the new suggestion on changing the range in an advanced filter. I`ll try that. I`m wondering - it`s rather urgent, under deadline today very soon - I`m coming up with an error in this code. Could you take a look at it and, if possible, check the whole code for any bugs. The first error that comes up is in the sub standardizeyears. It stops at the word "match" in the following line, and says "compile error: sub or function not defined". Do Until Cells(intRowx + 1, intCol).value = "" ' Loop until end of data If Match(Cells(intRowx, intCol).value, years, 0) = "#N/A" Then Call nonstandardyear(intRowx, intCol) This is the whole code. Sorry about the rush. Thanks, would be much appreciated. -- Dave Sub preparationfinaldata() Call standardizeyears Call standardizesubgroup End Sub Sub standardizeyears() Dim intRowx Dim intCol Dim years As Integer intRowx = 1 ' Start in the first row intCol = 2 ' The column in "final data" that contains the Years to check 'Create a reference in the Standards Worksheet called "Years" for the year columns Do Until Cells(intRowx + 1, intCol).value = "" ' Loop until end of data If Match(Cells(intRowx, intCol).value, years, 0) = "#N/A" Then Call nonstandardyear(intRowx, intCol) End If intRowx = intRowx + 1 ' Increment to next row Loop End Sub Sub nonstandardyear(r As Integer, c As Integer) Dim intLastCol Dim intYear intLastCol = 6 'Last nonempty column of excel sheet intYear = Cells(r, c).value Select Case Val(Cells(r, c).value) Case 1990 To 1999 Cells(r, c).value = VLookup(mround(Cells(r, c).value, 5), years, 1, False) Case Else Cells(r, c).value = VLookup(mround(Cells(r, c).value, 10), years, 1, False) End Select Cells(r, intLastCol).value = "This data refers to" & intYear End Sub Sub standardizesubgroup() Dim intRowx Dim intCol intRowx = 1 ' Start in the first row intCol = 6 ' The column in "final data" that contains the Years to check 'Create a reference in the Standards Worksheet called "subgroup" for the subgroup columns Do Until Cells(intRowx + 1, intCol).value = "" ' Loop until end of data If Match(Cells(intRowx, intCol).value, subgroup, 0) = "#N/A" Then Call nonstandardsubgroup(intRowx, intCol) End If intRowx = intRowx + 1 ' Increment to next row Loop End Sub Sub nonstandardsubgroup(r As Integer, c As Integer) Dim strDigits As String Dim intDigits As Integer Dim intLastCol intLastCol = 6 intDigits = Val(Left(Cells(rowx, col).value, 2)) + 5 strDigits = Str(intDigits) If Cells(r, intLastCol) = "" Then Cells(r, intLastCol) = VLookup(strDigits, subgroup, 1, True) Else Cells(r, intLastCol) = Cells(r, intLastCol) & VLookup(strDigits, subgroup, 1, True) End If End Sub *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
urgent - changing a range
Hi Dave,
Without otherwise looking at your code, change: Match to Application.Match Match is an Excel function not a VBA function. --- Regards, Norman -- --- Regards, Norman "david shapiro" wrote in message ... Norman and others, Thanks for the new suggestion on changing the range in an advanced filter. I`ll try that. I`m wondering - it`s rather urgent, under deadline today very soon - I`m coming up with an error in this code. Could you take a look at it and, if possible, check the whole code for any bugs. The first error that comes up is in the sub standardizeyears. It stops at the word "match" in the following line, and says "compile error: sub or function not defined". Do Until Cells(intRowx + 1, intCol).value = "" ' Loop until end of data If Match(Cells(intRowx, intCol).value, years, 0) = "#N/A" Then Call nonstandardyear(intRowx, intCol) This is the whole code. Sorry about the rush. Thanks, would be much appreciated. -- Dave Sub preparationfinaldata() Call standardizeyears Call standardizesubgroup End Sub Sub standardizeyears() Dim intRowx Dim intCol Dim years As Integer intRowx = 1 ' Start in the first row intCol = 2 ' The column in "final data" that contains the Years to check 'Create a reference in the Standards Worksheet called "Years" for the year columns Do Until Cells(intRowx + 1, intCol).value = "" ' Loop until end of data If Match(Cells(intRowx, intCol).value, years, 0) = "#N/A" Then Call nonstandardyear(intRowx, intCol) End If intRowx = intRowx + 1 ' Increment to next row Loop End Sub Sub nonstandardyear(r As Integer, c As Integer) Dim intLastCol Dim intYear intLastCol = 6 'Last nonempty column of excel sheet intYear = Cells(r, c).value Select Case Val(Cells(r, c).value) Case 1990 To 1999 Cells(r, c).value = VLookup(mround(Cells(r, c).value, 5), years, 1, False) Case Else Cells(r, c).value = VLookup(mround(Cells(r, c).value, 10), years, 1, False) End Select Cells(r, intLastCol).value = "This data refers to" & intYear End Sub Sub standardizesubgroup() Dim intRowx Dim intCol intRowx = 1 ' Start in the first row intCol = 6 ' The column in "final data" that contains the Years to check 'Create a reference in the Standards Worksheet called "subgroup" for the subgroup columns Do Until Cells(intRowx + 1, intCol).value = "" ' Loop until end of data If Match(Cells(intRowx, intCol).value, subgroup, 0) = "#N/A" Then Call nonstandardsubgroup(intRowx, intCol) End If intRowx = intRowx + 1 ' Increment to next row Loop End Sub Sub nonstandardsubgroup(r As Integer, c As Integer) Dim strDigits As String Dim intDigits As Integer Dim intLastCol intLastCol = 6 intDigits = Val(Left(Cells(rowx, col).value, 2)) + 5 strDigits = Str(intDigits) If Cells(r, intLastCol) = "" Then Cells(r, intLastCol) = VLookup(strDigits, subgroup, 1, True) Else Cells(r, intLastCol) = Cells(r, intLastCol) & VLookup(strDigits, subgroup, 1, True) End If End Sub *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
urgent - changing a range
Years would need to be a named range of size single row or single column.
(or put in a valid range of this type) Dim res as Variant res = ApplicationMatch(Cells(intRowx, intCol).value, Range("years"), 0) if iserror(res) then msgbox "Not found" else msgbox "found at " & Range("years")(res).Address end if -- Regards, Tom Ogilvy "david shapiro" wrote in message ... Norman and others, Thanks for the new suggestion on changing the range in an advanced filter. I`ll try that. I`m wondering - it`s rather urgent, under deadline today very soon - I`m coming up with an error in this code. Could you take a look at it and, if possible, check the whole code for any bugs. The first error that comes up is in the sub standardizeyears. It stops at the word "match" in the following line, and says "compile error: sub or function not defined". Do Until Cells(intRowx + 1, intCol).value = "" ' Loop until end of data If Match(Cells(intRowx, intCol).value, years, 0) = "#N/A" Then Call nonstandardyear(intRowx, intCol) This is the whole code. Sorry about the rush. Thanks, would be much appreciated. -- Dave Sub preparationfinaldata() Call standardizeyears Call standardizesubgroup End Sub Sub standardizeyears() Dim intRowx Dim intCol Dim years As Integer intRowx = 1 ' Start in the first row intCol = 2 ' The column in "final data" that contains the Years to check 'Create a reference in the Standards Worksheet called "Years" for the year columns Do Until Cells(intRowx + 1, intCol).value = "" ' Loop until end of data If Match(Cells(intRowx, intCol).value, years, 0) = "#N/A" Then Call nonstandardyear(intRowx, intCol) End If intRowx = intRowx + 1 ' Increment to next row Loop End Sub Sub nonstandardyear(r As Integer, c As Integer) Dim intLastCol Dim intYear intLastCol = 6 'Last nonempty column of excel sheet intYear = Cells(r, c).value Select Case Val(Cells(r, c).value) Case 1990 To 1999 Cells(r, c).value = VLookup(mround(Cells(r, c).value, 5), years, 1, False) Case Else Cells(r, c).value = VLookup(mround(Cells(r, c).value, 10), years, 1, False) End Select Cells(r, intLastCol).value = "This data refers to" & intYear End Sub Sub standardizesubgroup() Dim intRowx Dim intCol intRowx = 1 ' Start in the first row intCol = 6 ' The column in "final data" that contains the Years to check 'Create a reference in the Standards Worksheet called "subgroup" for the subgroup columns Do Until Cells(intRowx + 1, intCol).value = "" ' Loop until end of data If Match(Cells(intRowx, intCol).value, subgroup, 0) = "#N/A" Then Call nonstandardsubgroup(intRowx, intCol) End If intRowx = intRowx + 1 ' Increment to next row Loop End Sub Sub nonstandardsubgroup(r As Integer, c As Integer) Dim strDigits As String Dim intDigits As Integer Dim intLastCol intLastCol = 6 intDigits = Val(Left(Cells(rowx, col).value, 2)) + 5 strDigits = Str(intDigits) If Cells(r, intLastCol) = "" Then Cells(r, intLastCol) = VLookup(strDigits, subgroup, 1, True) Else Cells(r, intLastCol) = Cells(r, intLastCol) & VLookup(strDigits, subgroup, 1, True) End If End Sub *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
urgent - changing a range
Thanks to Tom, Norman and others for the suggestions on the code. For
some reason, this part - changing the range on the advanced filter still doesn`t work: I`m new to this, how could the following code be adjusted so that: "criteria file" - the criteria for the advanced filter "source data" - the large dataset from which to extract A new worksheet called "final data" is created, and the results of the advanced filter are put there. (Please do not overwrite/change contents of "criteria file"). The range on both the "criteria file" and "source data" should be the whole dataset in the worksheet. Norman, I`m not quite sure what you mean by criteria column (H). In this case, all of the columns in the "criteria file" are criteria, so how could this whole range be put? Would appreciate your suggestions. Thanks. - David Sub extractall() Dim rngData As Range, RngCrit As Range Dim rngOutput As Range With ActiveWorkbook With .Sheets("source data") Set rngData = .Range("A1").CurrentRegion ' End With With .Sheets("criteria file") Set RngCrit = .Range("A1").CurrentRegion ' Set rngOutput = .Range("A1") End With .Sheets("criteria file").Activate rngOutput.CurrentRegion.ClearContents rngData.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=RngCrit, _ CopyToRange:=rngOutput, _ Unique:=True End With End Sub *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Changing the range for averages with out changing the formula. | Excel Worksheet Functions | |||
Range formula - urgent! | Excel Discussion (Misc queries) | |||
URGENT: How to prevent data in cells from changing? | Excel Discussion (Misc queries) | |||
Urgent Dynamic Range with Vlookup | Excel Discussion (Misc queries) | |||
Urgent, help needed on range selection! | Excel Programming |