PDA

View Full Version : row selection



stefan0901
03-04-2009, 02:07 AM
I have an excel sheet with data in rows and columns. I would like to create a macro which select every row which has "empjj" as value for column K.
At this moment, I have made the folowing macro:

Sub Test1()

Dim i As Integer
Dim r
Dim n

Set r = Range("A1").CurrentRegion

For i = 1 To r.Rows.Count
If Cells(i, 11).Value = "EmpJJ" Then
Cells(i, 11).EntireRow.Select
End If
Next i

End Sub
The problem is that excel select each row succesively, but not all of them at the same time.

Is there anybody who can help me?

Bob Phillips
03-04-2009, 02:19 AM
Sub Test1()
Dim i As Integer
Dim r As Range
Dim n As Range

Set r = Range("A1").CurrentRegion

For i = 1 To r.Rows.Count

If Cells(i, 11).Value = "EmpJJ" Then

If n Is Nothing Then

Set n = Cells(i, 11)
Else

Set n = Union(n, Cells(i, 11))
End If
End If
Next i

If Not n Is Nothing Then n.EntireRow.Select

End Sub

JONvdHeyden
03-04-2009, 02:20 AM
Why do you want to select the rows? What are you going to do with the selection?

Consider using a filter, which is more efficient than a loop if the range is considerably large, e.g:

Sub FilterEmpJJ()
Dim rRng1 As Range, rRng2 As Range
rRng1 = Range("K1", Range("K" & Rows.Count).End(xlUp))
rRng2 = Range("K2", Range("K" & Rows.Count).End(xlUp))
With rRng1
.AutoFilter field:=1, Criteria1:="EmpJJ"
rRng2.SpecialCells(xlCellTypeVisible).EntireRow.Select
'.AutoFilter
End With
End Sub

stefan0901
03-04-2009, 03:04 AM
I want to delete these rows. I tried both of your codes and they work very good. Thank you. Is it also possible to select the rows where the value of a column (e.g. 'K') starts with the letter "a" ?

Bob Phillips
03-04-2009, 03:11 AM
ub Test1()
Dim i As Integer
Dim r As Range
Dim n As Range

Set r = Range("A1").CurrentRegion

For i = 1 To r.Rows.Count

If LCase(Cells(i, "K").Value) Like "a*" Then

If n Is Nothing Then

Set n = Cells(i, "K")
Else

Set n = Union(n, Cells(i, "K"))
End If
End If
Next i

If Not n Is Nothing Then n.EntireRow.Delete

End Sub

JONvdHeyden
03-04-2009, 04:09 AM
Or using autofilter:



Sub FilterEmpJJ()

Dim rRng1 As Range, rRng2 As Range
rRng1 = Range("K1", Range("K" & Rows.Count).End(xlUp))
rRng2 = Range("K2", Range("K" & Rows.Count).End(xlUp))
With rRng1
.AutoFilter field:=1, Criteria1:="a*"
rRng2.SpecialCells(xlCellTypeVisible).EntireRow.Delete
.AutoFilter
End With
End Sub

Gil
10-13-2009, 08:57 AM
Hello
Can I make a request on this thread to adapt for my own use.If so I would like to
Select all rows with EmpJJ (or my word) maybe a 100 rows and copy the lot & then paste to a new sheet.
One comment is that I could not get JONvdHeyden code to run. It stops on rRng1 = Range("K1", Range("K" & Rows.Count).End(xlUp)) with the message Run Time error 91. Object variable or with block variable not set.
Any help much appreciated

Thank you

Bob Phillips
10-13-2009, 09:07 AM
You should be able to adapt this



Sub CopyData()
Const SHEET_SOURCE As String = "Sheet2" '<<<< change to suit
Const SHEET_TARGET As String = "Sheet4" '<<<< change to suit
Const COLUMN_SOURCE As String = "F" '<<<< change to suit
Const WORD_TO_TEST As String = "MyWord" '<<<< change to suit
Dim LastRow As Long
Dim rng As Range

With Worksheets(SHEET_SOURCE)

LastRow = .Cells(.Rows.Count, COLUMN_SOURCE).End(xlUp).Row
Set rng = .Cells(1, COLUMN_SOURCE).Resize(LastRow)
rng.AutoFilter field:=1, Criteria1:=WORD_TO_TEST
On Error Resume Next
Set rng = rng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then

rng.EntireRow.Copy Worksheets(SHEET_TARGET).Range("A1")
End If
rng.AutoFilter
End With

End Sub

Gil
10-13-2009, 12:11 PM
Hello XLD

Thank you for the reply. This works fine in a macro used once but if I try to insert it later to filter out another word in a row i.e. NEW, EXISTS, DONOR etc I get the error message Compile Error duplicate declaration in current scope.I have attached an edited file with the macro in module 6.
Hope it makes sense what I want to do.

Bob Phillips
10-13-2009, 12:19 PM
Not really Gil. Can you post the workbook as is, with the error?

Gil
10-13-2009, 02:33 PM
Had a bit of trouble with the attachment but it is there now.

Gil
10-25-2009, 05:28 AM
Not really Gil. Can you post the workbook as is, with the error?

Hello xld

Sorry for the delay but have been away for a while. Can you look at my attachment and point me in the error of my ways.

Thanks
Gil

mdmackillop
10-25-2009, 05:43 AM
Hi Gil,
1. Always use Option Explicit
2. You are declaring constants twice. Delete this lot near the end of your sub. Just change the value as required

Const SHEET_SOURCE = "Edited1" '<<<< change to suit
Const SHEET_TARGET As String = "EXISTS" '<<<< change to suit
Const COLUMN_SOURCE As String = "A" '<<<< change to suit
Const WORD_TO_TEST As String = "EXISTS" '<<<< change to suit
Dim LastRow As Long
Dim rng As Range

3. This sheet does not exist
Sheets("Jumpering Schedule").Select

4. A bit neater


Dim ws
Dim ShNames, s

ShNames = Array("Edited", "NEW", "EXITS", "DONOR", "Lic to d", "e to bar pair")
For Each s In ShNames
Set ws = Sheets.Add
ws.Name = s
Next

Gil
10-25-2009, 07:10 AM
Hello mdmackillop

I have ammended attachment to the 3 points you made. The macro now runs & filters from edited and pastes into the 'NEW' sheet. I now need to include the next sheets filtering out the exists,donor etc but I dont know about the Option Explicit.Please help
Gil

2093

mdmackillop
10-25-2009, 08:11 AM
I've cleared out a lot of the excess code created by recording and then you just need a simple loop to filter and copy the data.
Option Explicit requires the declaration of variables and helps prevent errors.


Option Explicit
Sub MPFFiltering1()
'
' MPFFiltering Macro
Dim ws As Worksheet
Dim ShNames, s
Dim wsSource As Worksheet
Dim FiltRng As Range
Dim Tgts, t
Dim rng As Range
Const COLUMN_SOURCE As String = "A" '<<<< change to suit
ShNames = Array("EDITED", "NEW", "EXISTS", "DONOR", "LIC to D", "E to BAR PAIR")
For Each s In ShNames
Set ws = Sheets.Add
ws.Name = s
Next
Set wsSource = Sheets("Edited")
Sheets("Filter Schedule").Cells.Copy wsSource.Range("A1")
With wsSource
.Activate
.Rows("2:15").Delete
With .Cells
.Font.Bold = False
.Borders.LineStyle = xlNone
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
End With
With .Range("A1:I1")
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.UnMerge
End With
.Columns("E:E").ColumnWidth = 18
With .Rows("1:1").Font
.FontStyle = "Regular"
.Size = 16
End With
.Columns(6).Delete
.Columns(4).Delete
.PageSetup.PrintArea = ""
With .PageSetup
.LeftFooter = "Edited"
.CenterFooter = "&F &A"
.RightFooter = "&P of &N"
End With

Set rng = .Columns("A:G")
End With

Tgts = Array("NEW", "EXISTS", "DONOR")

For Each t In Tgts
rng.AutoFilter field:=1, Criteria1:=t
On Error Resume Next
Set FiltRng = rng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not FiltRng Is Nothing Then
FiltRng.EntireRow.Copy Worksheets(t).Range("A1")
End If
rng.AutoFilter
Next
End Sub

Gil
10-25-2009, 11:11 AM
Hello mdmackillop
You have really helped with this problem I have been working on. The whole problem is almost resolved. You have shown how some tedious keyboard entries can be made to look very neat and tidy. The last 2 requests are to add the footer for each sheet and to set column widths for each sheet.
Many thanks
Gil

mdmackillop
10-25-2009, 12:18 PM
For Each t In Tgts
rng.AutoFilter field:=1, Criteria1:=t
On Error Resume Next
Set FiltRng = rng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not FiltRng Is Nothing Then
FiltRng.EntireRow.Copy Worksheets(t).Range("A1")
End If
rng.AutoFilter
With Sheets(t).PageSetup
.LeftFooter = t
.CenterFooter = "&F &A"
.RightFooter = "&P of &N"
End With
Sheets(t).Columns("A:I").EntireColumn.AutoFit
Next

Gil
10-25-2009, 09:48 PM
Hello mdmackillop
As ever there is always one who wont go away. I have some headings (not column) that would be in row A1, B1 & D1. I want to cut and paste into the "header left middle right" sections in that order and repeat on each sheet. The row can then remain blank and does not need deleting.
This really is nearly the end for this one
Gil

Gil
10-27-2009, 02:05 PM
2118Hello mdmackillop

Me again. Last is that I want to be able to change the font size to 10 from 8 in all of the inserted sheets & autofit the columns. I have tried but it has me stumped Nothing else will be required so shall I then close it as solved even though I tagged on to someone else's thread.