Need macro snippet for Filtering Non-Repetitive, Dynamic data/values for Repetitive macro usage.

Status
Not open for further replies.
Y

Yup

New Member
Joined
Sep 6, 2022
Messages
13
Office Version
  1. 365
Platform
  1. Windows
Hi, I have to copy rows from one sheet to other in a same excel file. It's a repetitive task to be conducted on weekly basis. Consider following example.

NameDevicescode
ADesktop234
BLaptop2345
CTelevision3456
DSmartphone7654
EPrinterNA
FDesktop098
GScannerNA
HLaptop65
ISmartphone876
JLaptop345
K
LTelevision3456
MNANA
NLaptop1234
ODesktop8797

I have to copy rows containing any value except "NA" or 'Blank' in column "code" from one sheet to another.
All values in column "code" are unique & will never repeat except 'NA' value & blank space.
How do I use filter to select non-repeating values, without using below mentioned code snippet.

VBA Code: 
Selection.AutoFilter
ActiveSheet.Range("$A$1:$C$16").AutoFilter Field:=3, Criteria1:=Array("____", "____", "____", "____", ~~& so on~~), Operator:=xlFilterValues

Above code snippet will be useless for repetitive use as values are non-repeating.

Also, on side note,
How to deal with blanks? (for both cases i.e., inclusion & exclusion)

Thanks in advance..... :)
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
Sort by date Sort by votes
paste into a module, then run: CopyNonNullData
it filters your data to exclude nulls & NA
then copies it to new sheet.


Code: 
Option Explicit

'---------------------
Sub CopyNonNullData()
'---------------------
Dim iRows As Long, iFldNum As Long, iResultOFF As Long
Dim vTxt
Dim sResultCol As String
Const kResultHdr = "Results"
Const kFOUND = "found"
Dim i As Integer, iSrchCol As Integer, iCols As Long, iResultCol As Integer
Dim bFound As Boolean

Dim pvFldName
pvFldName = "Code"

  'add a result column
Range("A1").Select
While Not bFound
   If UCase(ActiveCell.Value) = UCase(pvFldName) Then
     bFound = True
     iSrchCol = ActiveCell.Column
   Else
     ActiveCell.Offset(0, 1).Select 'next column
   End If
Wend

If bFound Then
    'MsgBox iRows
    iRows = ActiveSheet.UsedRange.Rows.Count
    iCols = ActiveSheet.UsedRange.Columns.Count
    iResultCol = iCols - iSrchCol + 1
    
    'CLEAR PREV RESULTS
    sResultCol = Chr(iSrchCol + 65)
    Columns(sResultCol & ":" & sResultCol).ClearContents
    Range(sResultCol & "1").Value = kResultHdr    'make header col.
    iResultCol = 1
    
      'start scan for data
    ActiveCell.Offset(1, 0).Select 'next row
    While ActiveCell.Row <= iRows
       vTxt = ActiveCell.Value
       If vTxt <> "" And vTxt <> "NA" Then
           ActiveCell.Offset(0, iResultCol).Value = kFOUND
       End If
       
       ActiveCell.Offset(1, 0).Select 'next row
    Wend
Else
  MsgBox pvFldName & " not found"
End If

On Error Resume Next
 'filter results to be copied
 Range("a1").Select
ActiveSheet.Range("A1").AutoFilter Field:=iCols, Criteria1:=kFOUND

'copy the results
SaveFoundData
End Sub

'---------------------
Private Sub SaveFoundData()
'---------------------
Range("A1").Select
ActiveSheet.UsedRange.Select
     'Range("A1:G27").Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    'Workbooks.Add
    
    ActiveSheet.Paste
    Application.CutCopyMode = False
Range("A1").Select
    
    'ActiveWorkbook.SaveAs Filename:="C:\TEMP\found data.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
 
Upvote 1
How about
VBA Code: 
ActiveSheet.Range("$A$1:$C$16").AutoFilter 3, "<>NA", xlAnd, "<>"
 
Upvote 1
Solution
ranman256 said:
paste into a module, then run: CopyNonNullData
it filters your data to exclude nulls & NA
then copies it to new sheet.


Code: 
Option Explicit

'---------------------
Sub CopyNonNullData()
'---------------------
Dim iRows As Long, iFldNum As Long, iResultOFF As Long
Dim vTxt
Dim sResultCol As String
Const kResultHdr = "Results"
Const kFOUND = "found"
Dim i As Integer, iSrchCol As Integer, iCols As Long, iResultCol As Integer
Dim bFound As Boolean

Dim pvFldName
pvFldName = "Code"

  'add a result column
Range("A1").Select
While Not bFound
   If UCase(ActiveCell.Value) = UCase(pvFldName) Then
     bFound = True
     iSrchCol = ActiveCell.Column
   Else
     ActiveCell.Offset(0, 1).Select 'next column
   End If
Wend

If bFound Then
    'MsgBox iRows
    iRows = ActiveSheet.UsedRange.Rows.Count
    iCols = ActiveSheet.UsedRange.Columns.Count
    iResultCol = iCols - iSrchCol + 1
   
    'CLEAR PREV RESULTS
    sResultCol = Chr(iSrchCol + 65)
    Columns(sResultCol & ":" & sResultCol).ClearContents
    Range(sResultCol & "1").Value = kResultHdr    'make header col.
    iResultCol = 1
   
      'start scan for data
    ActiveCell.Offset(1, 0).Select 'next row
    While ActiveCell.Row <= iRows
       vTxt = ActiveCell.Value
       If vTxt <> "" And vTxt <> "NA" Then
           ActiveCell.Offset(0, iResultCol).Value = kFOUND
       End If
      
       ActiveCell.Offset(1, 0).Select 'next row
    Wend
Else
  MsgBox pvFldName & " not found"
End If

On Error Resume Next
 'filter results to be copied
 Range("a1").Select
ActiveSheet.Range("A1").AutoFilter Field:=iCols, Criteria1:=kFOUND

'copy the results
SaveFoundData
End Sub

'---------------------
Private Sub SaveFoundData()
'---------------------
Range("A1").Select
ActiveSheet.UsedRange.Select
     'Range("A1:G27").Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    'Workbooks.Add
   
    ActiveSheet.Paste
    Application.CutCopyMode = False
Range("A1").Select
   
    'ActiveWorkbook.SaveAs Filename:="C:\TEMP\found data.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
Click to expand...

Hi, your code is bit complex & I was unable to modify as per my need. Sorry for the trouble. :)
 
Upvote 0
Fluff said:
How about
VBA Code: 
ActiveSheet.Range("$A$1:$C$16").AutoFilter 3, "<>NA", xlAnd, "<>"
Click to expand...

Hi,
Thanks, It worked :) .
But can you please also guide me on how to copy the data. If I try traditionally, it will select a specific cell in the code & copy from thereafter. Due to it being dynamic data, it won't work for next time.
I can handle the pasting part. Need help on data copying part.
Thanks :)
 
Upvote 0
Where do you want to copy it to?
 
Upvote 0
Fluff said:
Where do you want to copy it to?
Click to expand...
I want to copy the data in another sheet in same excel file at 'B3' cell. (The data to be copied starts from 'B' column, column 'A' is 'Sr. No.').
Also
If I want to modify the code & pre apply another condition, how should I go about it ? e.g. needing to copy the rows with the 'code' for only 'Laptop' 'Devices' ?(some 'Laptop" may also have code 'NA').

I need the macro for these 2 conditions/filters.

Thanks in Advance :)
 
Upvote 0
Fluff said:
Where do you want to copy it to?
Click to expand...
Hi,
Sorry 😅. data is confidential. So, I can't share the sheet with XL2BB.
It is quite similar to this table.
Sr. No.NameDevicescode
1ADesktop234
2BLaptopN2345
3CTelevision3456
4DSmartphone7654
5EPrinterNA
6FDesktopOp098
7GScannerNA
8HLaptopNA
9ISmartphoneSA876
10JLaptop345QT
11K
12LTelevision3456
13MNANA
14NLaptopGH1234
15ODesktop8797

Instead here is the code I am using

VBA Code:
Sub Macro1()
'
' Macro1 Macro
' Trial1
'
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Worksheets("Sheet1") '<~~ change to suit
Set ws2 = Worksheets("Sheet2") '<~~ change to suit

With ws1.Range("A1").CurrentRegion
.AutoFilter 3, "Laptop", xlAnd, "Desktop"
.AutoFilter 4, "<>NA", xlAnd, "<>"
If ws1.Cells(Rows.Count, 1).End(xlUp).Row > 1 Then
.Offset(1).Resize(.Rows.Count - 1).Copy ws2.Range("B3") '<~~ change destination to suit
End If
.AutoFilter
End With
'
End Sub

I have modified the code as per my need.
but following issues are present.
1) When I run this code, absolutely nothing is happening. :(
There is no error & no data being copy pasted either.
It worked when there was only single AutoFilter.
2) While copying data from sheet1, I want to copy data from column 'B' & paste it in sheet2 from Cell 'B3'.
3) I also want to implement, following code in the above macro.

VBA Code:
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Thanks in Advance :)
 
Upvote 0
An Update :

VBA Code: 
Sub Macro1()
'
' Macro1 Macro
' Trial1
'
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Worksheets("Sheet1") '<~~ change to suit
Set ws2 = Worksheets("Sheet2") '<~~ change to suit

With ws1.Range("A1").CurrentRegion
.AutoFilter 3, "Laptop", [COLOR=rgb(184, 49, 47)][B]xlOr[/B][/COLOR], "Desktop"
.AutoFilter 4, "<>NA", xlAnd, "<>"
If ws1.Cells(Rows.Count, 1).End(xlUp).Row > 1 Then
.Offset(1).Resize(.Rows.Count - 1).Copy ws2.Range("B3") '<~~ change destination to suit
End If
.AutoFilter
End With
'
End Sub


Using xlOr instead of xlAnd has solved my first issue. (Silly me)
Need help for 2nd & 3rd issue only. i.e.,
2) While copying data from sheet1, I want to copy data from column 'B' & paste it in sheet2 from Cell 'B3'.
3) I also want to implement, following code in the above macro.

VBA Code: 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Thanks in Advance :)
 
Upvote 0
Status
Not open for further replies.

Similar threads

Y
  • Solved
Need a Macro code to filter & unselect a specific value.
2
Replies
10
Views
906
Fluff
Fluff
Y
  • Locked
  • Solved
Macro code to autofilter & select dynamic data.
Replies
2
Views
402
Fluff
Fluff
L
  • Question Question
vba macro dynamically use multiple criteria for filters across multiple columns to then copy and paste to other sheet
Replies
2
Views
18K
Lisa Harris
L
C
  • Question Question
Copy and Paste only if certain cells in columns are blank
Replies
0
Views
2K
Conell8383
C
S
  • Question Question
Filter data based on a column and calculate average dynamically for all the filtered rows
Replies
2
Views
1K
Fazza
F

Forum statistics

Threads
1,223,886
Messages
6,175,195
Members
452,616
Latest member
intern444

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top