morsoe
02-26-2014, 01:05 AM
I wish to extract a selection of fields from one list in sheet1 to a target area in second sheet matching specified criteria. Basically, this is done using Excel Advanced Filter, specifying relevant arguments (looping through the list of criteria values).
rSourceRng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(sFiltRng), CopyToRange:=WS2.Range(sDestRng), Unique:=True
Each criteria is a numeric values (following a standard Danish standard numeric format) formatted as text which applies also for the values listed in database.
The problem is that Filtercopy does not return those database records listed with criteria value below 7 characters (in this case values below 1.000.000).
Excel itself will gladly return all records matching the extract criteria. (Test by placing the curser in the target range before activating advanced filter). Note also, that the worksheet function =dcounta will return the correct number of records as well in VBA as in Excel.
Any ideas?I wish to extract a selection of fields from one list in sheet1 to a target area in second sheet matching specified criteria. Basically, this is done using Excel Advanced Filter, specifying relevant arguments (looping through the list of criteria values).
rSourceRng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(sFiltRng), CopyToRange:=WS2.Range(sDestRng), Unique:=True
Each criteria is a numeric values (following a standard Danish standard numeric format) formatted as text which applies also for the values listed in database.
The problem is that Filtercopy does not return those database records listed with criteria value below 7 characters (in this case values below 1.000.000).
Excel itself will gladly return all records matching the extract criteria. (Test by placing the curser in the target range before activating advanced filter). Note also, that the worksheet function =dcounta will return the correct number of records as well in VBA as in Excel.
Any ideas?
Sub FilterCopy()
'---
'Extract records using advanced filter
'---
Dim WS1 As Worksheet, WS2 As Worksheet, cl As Range
Dim rSourceRng As Range 'Database list
Dim rTargetRng As Range 'Extract to range
Dim rFilterRng As Range 'Filter range
Dim rExtractLst As Range 'List of values to iterate
Dim sDestRng As String ')
Dim sFiltRng As String ') String arguments
Dim lRecords As Long 'Count of matching records in database
Set WS1 = Worksheets("SourceData")
Set WS2 = Worksheets("TargetData")
Set rExtractLst = Range("VBARefList")
Set rSourceRng = WS1.Range("A1").CurrentRegion
Set rTargetRng = WS2.Range("A1")
Set rFilterRng = Range("VBACriteria")
For Each cl In rExtractLst 'Iterate list of criteria to examine individually
'Place criteria value in criteria range
rFilterRng.Cells(2).Formula = "=" & """=" & cl.Value & """"
'Clear target area to eliminate from preceding iteration
rTargetRng.CurrentRegion.Offset(1, 0).EntireRow.Delete
'Measure string arguments of records coming from source data
lRecords = Application.DCountA(rSourceRng, 1, rFilterRng) + 1
sDestRng = Range(WS2.Cells(1, 1), WS2.Cells(lRecords, rTargetRng.CurrentRegion.Columns.Count)).Address
sFiltRng = "'" & rFilterRng.Parent.Name & "'!" & rFilterRng.Address
'Execute advance filter copy
rSourceRng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(sFiltRng), CopyToRange:=WS2.Range(sDestRng), Unique:=True
Next cl
'Finish off
Set WS1 = Nothing
Set WS2 = Nothing
Set rSourceRng = Nothing
Set rTargetRng = Nothing
Set rFilterRng = Nothing
Set rExtractLst = Nothing
MsgBox "Finished...", vbOKOnly + vbInformation, "VBA\ Filtercopy"
End Sub
rSourceRng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(sFiltRng), CopyToRange:=WS2.Range(sDestRng), Unique:=True
Each criteria is a numeric values (following a standard Danish standard numeric format) formatted as text which applies also for the values listed in database.
The problem is that Filtercopy does not return those database records listed with criteria value below 7 characters (in this case values below 1.000.000).
Excel itself will gladly return all records matching the extract criteria. (Test by placing the curser in the target range before activating advanced filter). Note also, that the worksheet function =dcounta will return the correct number of records as well in VBA as in Excel.
Any ideas?I wish to extract a selection of fields from one list in sheet1 to a target area in second sheet matching specified criteria. Basically, this is done using Excel Advanced Filter, specifying relevant arguments (looping through the list of criteria values).
rSourceRng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(sFiltRng), CopyToRange:=WS2.Range(sDestRng), Unique:=True
Each criteria is a numeric values (following a standard Danish standard numeric format) formatted as text which applies also for the values listed in database.
The problem is that Filtercopy does not return those database records listed with criteria value below 7 characters (in this case values below 1.000.000).
Excel itself will gladly return all records matching the extract criteria. (Test by placing the curser in the target range before activating advanced filter). Note also, that the worksheet function =dcounta will return the correct number of records as well in VBA as in Excel.
Any ideas?
Sub FilterCopy()
'---
'Extract records using advanced filter
'---
Dim WS1 As Worksheet, WS2 As Worksheet, cl As Range
Dim rSourceRng As Range 'Database list
Dim rTargetRng As Range 'Extract to range
Dim rFilterRng As Range 'Filter range
Dim rExtractLst As Range 'List of values to iterate
Dim sDestRng As String ')
Dim sFiltRng As String ') String arguments
Dim lRecords As Long 'Count of matching records in database
Set WS1 = Worksheets("SourceData")
Set WS2 = Worksheets("TargetData")
Set rExtractLst = Range("VBARefList")
Set rSourceRng = WS1.Range("A1").CurrentRegion
Set rTargetRng = WS2.Range("A1")
Set rFilterRng = Range("VBACriteria")
For Each cl In rExtractLst 'Iterate list of criteria to examine individually
'Place criteria value in criteria range
rFilterRng.Cells(2).Formula = "=" & """=" & cl.Value & """"
'Clear target area to eliminate from preceding iteration
rTargetRng.CurrentRegion.Offset(1, 0).EntireRow.Delete
'Measure string arguments of records coming from source data
lRecords = Application.DCountA(rSourceRng, 1, rFilterRng) + 1
sDestRng = Range(WS2.Cells(1, 1), WS2.Cells(lRecords, rTargetRng.CurrentRegion.Columns.Count)).Address
sFiltRng = "'" & rFilterRng.Parent.Name & "'!" & rFilterRng.Address
'Execute advance filter copy
rSourceRng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(sFiltRng), CopyToRange:=WS2.Range(sDestRng), Unique:=True
Next cl
'Finish off
Set WS1 = Nothing
Set WS2 = Nothing
Set rSourceRng = Nothing
Set rTargetRng = Nothing
Set rFilterRng = Nothing
Set rExtractLst = Nothing
MsgBox "Finished...", vbOKOnly + vbInformation, "VBA\ Filtercopy"
End Sub