ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Advanced filter macro (https://www.excelbanter.com/excel-programming/421094-advanced-filter-macro.html)

BOSS
Advanced filter macro
 
I have a system fromwhich i need to prepare MIS.

I dump all the files into one file then i do advanced filter to get results
i need.

I recorded a macro and did come changes to make it suitable for my project.
below is the code.

' do advanced filter

Range("A1:AD65000").AdvancedFilter Action:=xlFilterInPlace,
CriteriaRange:= _
Sheets("Filterref").Range("A1:AD16"), Unique:=False
Sheets("raw").Select
Range("A1").Select

' copy required data into another sheet

ActiveCell.Range("A1:AD65000").Select
Selection.Copy
Sheets("brkp").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Sheets("raw").Select
Range("A1").Select

'remove filter
With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Application.CutCopyMode = False

The filter is processed on the basis of the range specified.

"Sheets("Filterref").Range("A1:AD16"), Unique:=False"

Can the filter reference be something like

Range(Selection, Selection.End(xlUp)).Select

I mean can the range be set to all the cells in some specific sheet.

Please let me know. Thanks!
Boss

BOSS
Advanced filter macro
 
Hi,

In other words i have two sheets in a file first one being "New" and second
one being "old"

Both has more than 25000 records but in same format.

how can i find out the same records between these two sheets.

I tried it with adanced filter but failed... please help.. Thanks!

Boss

"Boss" wrote:

I have a system fromwhich i need to prepare MIS.

I dump all the files into one file then i do advanced filter to get results
i need.

I recorded a macro and did come changes to make it suitable for my project.
below is the code.

' do advanced filter

Range("A1:AD65000").AdvancedFilter Action:=xlFilterInPlace,
CriteriaRange:= _
Sheets("Filterref").Range("A1:AD16"), Unique:=False
Sheets("raw").Select
Range("A1").Select

' copy required data into another sheet

ActiveCell.Range("A1:AD65000").Select
Selection.Copy
Sheets("brkp").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Sheets("raw").Select
Range("A1").Select

'remove filter
With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Application.CutCopyMode = False

The filter is processed on the basis of the range specified.

"Sheets("Filterref").Range("A1:AD16"), Unique:=False"

Can the filter reference be something like

Range(Selection, Selection.End(xlUp)).Select

I mean can the range be set to all the cells in some specific sheet.

Please let me know. Thanks!
Boss

ryguy7272
Advanced filter macro
 
There are multiple ways to do the comparison. Here are a few:
Sub Compare2Shts()
For Each Cell In Worksheets("CompareSheet#1").UsedRange
If Cell.Value < Worksheets("CompareSheet#2").Range(Cell.Address) Then
Cell.Interior.ColorIndex = 3
End If
Next

For Each Cell In Worksheets("CompareSheet#2").UsedRange
If Cell.Value < Worksheets("CompareSheet#1").Range(Cell.Address) Then
Cell.Interior.ColorIndex = 3
End If
Next
End Sub


Sub CompareAnother2Shts()
For Each Cell In Worksheets("CompareSheet#1").Range("A1:J50")
If Cell.Value < Worksheets("CompareSheet#2").Range(Cell.Address) Then
Cell.Interior.ColorIndex = 3
End If
Next

For Each Cell In Worksheets("CompareSheet#2").Range("A1:J50")
If Cell.Value < Worksheets("CompareSheet#1").Range(Cell.Address) Then
Cell.Interior.ColorIndex = 3
End If
Next
End Sub

Also........
Sub FindDupes() 'assuming both sheets are in same book and book is open
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim cell1 As Range
Dim cell2 As Range
Dim str As String
str = InputBox("Type name of first sheet")
Set sht1 = Worksheets(str)
str = InputBox("Type name of second sheet")
Set sht2 = Worksheets(str)


sht1.Range("A65536").End(xlDown).Activate
Selection.End(xlUp).Activate
LastRowSht1 = ActiveCell.Row

sht2.Activate
sht2.Range("A65536").End(xlDown).Activate
Selection.End(xlUp).Activate
LastRowSht2 = ActiveCell.Row

sht1.Activate
For rowSht1 = 1 To LastRowSht1
If sht1.Cells(rowSht1, 1) = "" Then Exit Sub
For rowSht2 = 1 To LastRowSht2
If sht1.Cells(rowSht1, 1).Value = sht2.Cells(rowSht2, 1).Value
Then
sht1.Cells(rowSht1, 1).Interior.ColorIndex = 3
sht2.Cells(rowSht2, 1).Interior.ColorIndex = 3

End If
Next
Next
sht1.Cells(1, 1).Select
End Sub

And so on, and so forth.........
Sub checkrev()

With Sheets("Sheet1")
Sh1LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set Sh1Range = .Range("A1:A" & Sh1LastRow)
End With
With Sheets("Sheet2")
Sh2LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set Sh2Range = .Range("A1:A" & Sh2LastRow)
End With

'compare sheet 1 with sheet 2
For Each Sh1cell In Sh1Range
Set c = Sh2Range.Find( _
what:=Sh1cell, LookIn:=xlValues)
If c Is Nothing Then
Sh1cell.Interior.ColorIndex = 3
Sh1cell.Offset(0, 1).Interior.ColorIndex = 3
Else
If Sh1cell.Offset(0, 1) < c.Offset(0, 1) Then
Sh1cell.Interior.ColorIndex = 6
Sh1cell.Offset(0, 1).Interior.ColorIndex = 6
End If
End If
Next Sh1cell
'compare sheet 2 with sheet 1
For Each Sh2cell In Sh2Range
Set c = Sh1Range.Find( _
what:=Sh2cell, LookIn:=xlValues)
If c Is Nothing Then
Sh2cell.Interior.ColorIndex = 3
Sh2cell.Offset(0, 1).Interior.ColorIndex = 3
Else
If Sh2cell.Offset(0, 1) < c.Offset(0, 1) Then
Sh2cell.Interior.ColorIndex = 6
Sh2cell.Offset(0, 1).Interior.ColorIndex = 6
End If
End If
Next Sh2cell

End Sub


Regards,
Ryan---

--
RyGuy


"Boss" wrote:

Hi,

In other words i have two sheets in a file first one being "New" and second
one being "old"

Both has more than 25000 records but in same format.

how can i find out the same records between these two sheets.

I tried it with adanced filter but failed... please help.. Thanks!

Boss

"Boss" wrote:

I have a system fromwhich i need to prepare MIS.

I dump all the files into one file then i do advanced filter to get results
i need.

I recorded a macro and did come changes to make it suitable for my project.
below is the code.

' do advanced filter

Range("A1:AD65000").AdvancedFilter Action:=xlFilterInPlace,
CriteriaRange:= _
Sheets("Filterref").Range("A1:AD16"), Unique:=False
Sheets("raw").Select
Range("A1").Select

' copy required data into another sheet

ActiveCell.Range("A1:AD65000").Select
Selection.Copy
Sheets("brkp").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Sheets("raw").Select
Range("A1").Select

'remove filter
With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Application.CutCopyMode = False

The filter is processed on the basis of the range specified.

"Sheets("Filterref").Range("A1:AD16"), Unique:=False"

Can the filter reference be something like

Range(Selection, Selection.End(xlUp)).Select

I mean can the range be set to all the cells in some specific sheet.

Please let me know. Thanks!
Boss

BOSS
Advanced filter macro
 
This is too good... You made my day..!!

Can we do something like this... if the macro finds any difference then it
adds a value to the first column of the row. The wasy its changing colur.

"ryguy7272" wrote:

There are multiple ways to do the comparison. Here are a few:
Sub Compare2Shts()
For Each Cell In Worksheets("CompareSheet#1").UsedRange
If Cell.Value < Worksheets("CompareSheet#2").Range(Cell.Address) Then
Cell.Interior.ColorIndex = 3
End If
Next

For Each Cell In Worksheets("CompareSheet#2").UsedRange
If Cell.Value < Worksheets("CompareSheet#1").Range(Cell.Address) Then
Cell.Interior.ColorIndex = 3
End If
Next
End Sub


Sub CompareAnother2Shts()
For Each Cell In Worksheets("CompareSheet#1").Range("A1:J50")
If Cell.Value < Worksheets("CompareSheet#2").Range(Cell.Address) Then
Cell.Interior.ColorIndex = 3
End If
Next

For Each Cell In Worksheets("CompareSheet#2").Range("A1:J50")
If Cell.Value < Worksheets("CompareSheet#1").Range(Cell.Address) Then
Cell.Interior.ColorIndex = 3
End If
Next
End Sub

Also........
Sub FindDupes() 'assuming both sheets are in same book and book is open
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim cell1 As Range
Dim cell2 As Range
Dim str As String
str = InputBox("Type name of first sheet")
Set sht1 = Worksheets(str)
str = InputBox("Type name of second sheet")
Set sht2 = Worksheets(str)


sht1.Range("A65536").End(xlDown).Activate
Selection.End(xlUp).Activate
LastRowSht1 = ActiveCell.Row

sht2.Activate
sht2.Range("A65536").End(xlDown).Activate
Selection.End(xlUp).Activate
LastRowSht2 = ActiveCell.Row

sht1.Activate
For rowSht1 = 1 To LastRowSht1
If sht1.Cells(rowSht1, 1) = "" Then Exit Sub
For rowSht2 = 1 To LastRowSht2
If sht1.Cells(rowSht1, 1).Value = sht2.Cells(rowSht2, 1).Value
Then
sht1.Cells(rowSht1, 1).Interior.ColorIndex = 3
sht2.Cells(rowSht2, 1).Interior.ColorIndex = 3

End If
Next
Next
sht1.Cells(1, 1).Select
End Sub

And so on, and so forth.........
Sub checkrev()

With Sheets("Sheet1")
Sh1LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set Sh1Range = .Range("A1:A" & Sh1LastRow)
End With
With Sheets("Sheet2")
Sh2LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set Sh2Range = .Range("A1:A" & Sh2LastRow)
End With

'compare sheet 1 with sheet 2
For Each Sh1cell In Sh1Range
Set c = Sh2Range.Find( _
what:=Sh1cell, LookIn:=xlValues)
If c Is Nothing Then
Sh1cell.Interior.ColorIndex = 3
Sh1cell.Offset(0, 1).Interior.ColorIndex = 3
Else
If Sh1cell.Offset(0, 1) < c.Offset(0, 1) Then
Sh1cell.Interior.ColorIndex = 6
Sh1cell.Offset(0, 1).Interior.ColorIndex = 6
End If
End If
Next Sh1cell
'compare sheet 2 with sheet 1
For Each Sh2cell In Sh2Range
Set c = Sh1Range.Find( _
what:=Sh2cell, LookIn:=xlValues)
If c Is Nothing Then
Sh2cell.Interior.ColorIndex = 3
Sh2cell.Offset(0, 1).Interior.ColorIndex = 3
Else
If Sh2cell.Offset(0, 1) < c.Offset(0, 1) Then
Sh2cell.Interior.ColorIndex = 6
Sh2cell.Offset(0, 1).Interior.ColorIndex = 6
End If
End If
Next Sh2cell

End Sub


Regards,
Ryan---

--
RyGuy


"Boss" wrote:

Hi,

In other words i have two sheets in a file first one being "New" and second
one being "old"

Both has more than 25000 records but in same format.

how can i find out the same records between these two sheets.

I tried it with adanced filter but failed... please help.. Thanks!

Boss

"Boss" wrote:

I have a system fromwhich i need to prepare MIS.

I dump all the files into one file then i do advanced filter to get results
i need.

I recorded a macro and did come changes to make it suitable for my project.
below is the code.

' do advanced filter

Range("A1:AD65000").AdvancedFilter Action:=xlFilterInPlace,
CriteriaRange:= _
Sheets("Filterref").Range("A1:AD16"), Unique:=False
Sheets("raw").Select
Range("A1").Select

' copy required data into another sheet

ActiveCell.Range("A1:AD65000").Select
Selection.Copy
Sheets("brkp").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Sheets("raw").Select
Range("A1").Select

'remove filter
With ActiveSheet
If .FilterMode Then
.ShowAllData
End If
End With

Application.CutCopyMode = False

The filter is processed on the basis of the range specified.

"Sheets("Filterref").Range("A1:AD16"), Unique:=False"

Can the filter reference be something like

Range(Selection, Selection.End(xlUp)).Select

I mean can the range be set to all the cells in some specific sheet.

Please let me know. Thanks!
Boss


All times are GMT +1. The time now is 11:37 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com