Select Rows based on cell value

kamalm

New Member
Joined
Jul 30, 2018
Messages
33
Hi, I use this code to select all Rows that contain number 3 based on column F. The code will select the Entire Row. But what I really want is the Rows contain number 3 to be selected only until Column X, not the entire Row. How can I do that ?

Code:
Sub SelRows()
Dim ocell As Range
Dim rng As Range


For Each ocell In Range("F:F")


If ocell.Value = "3" Then


If rng Is Nothing Then


Set rng = ocell.EntireRow
Else


Set rng = Union(rng, ocell.EntireRow)
End If
End If
Next


If Not rng Is Nothing Then rng.Select


Set rng = Nothing
Set ocell = Nothing
End Sub
 
Last edited:

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Not sure what your ultimate goal is:
Try this:

Code:
Sub SelRows()
'Modified  8/20/2018  3:05:25 AM  EDT
Dim ocell As Range
Dim rng As Range
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "F").End(xlUp).Row

For Each ocell In Range("F1:F" & Lastrow)
    If ocell.Value = "3" Then
If rng Is Nothing Then
Set rng = ocell.Resize(, 19)
Else
Set rng = Union(rng, ocell.Resize(, 19))

End If
End If
Next
If Not rng Is Nothing Then rng.Select
Set rng = Nothing
Set ocell = Nothing
End Sub
 
Upvote 0
Code:
Sub SelRows()
'Modified  8/20/2018  3:05:25 AM  EDT
Dim ocell As Range
Dim rng As Range
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "F").End(xlUp).Row

For Each ocell In Range("F1:F" & Lastrow)
    If ocell.Value = "3" Then
If rng Is Nothing Then
Set rng = ocell.Resize(, 19)
Else
Set rng = Union(rng, ocell.Resize(, 19))

End If
End If
Next
If Not rng Is Nothing Then rng.Select
Set rng = Nothing
Set ocell = Nothing
End Sub

Hi, I'm sorry. I forget to tell you that actually I need it to select from Column A until Column X. Your code did work to select until Column X but it miss Column A to E
 
Upvote 0
Code:
Sub SelRows()
Dim rng As Range, r&
Rows(1).Insert
[F:F].AutoFilter Field:=1, Criteria1:="3"
r = Cells(Rows.Count, "F").End(xlUp).Row
If r > 1 Then
    Set rng = Intersect(Range("F2:F" & Cells(Rows.Count, "F").End(xlUp).Row) _
        .SpecialCells(xlCellTypeVisible).EntireRow, [A:X])
    rng.Select
End If
Rows(1).Delete
End Sub
 
Last edited:
Upvote 0
Code:
Sub SelRows()
Dim rng As Range
Rows(1).Insert
[F:F].AutoFilter Field:=1, Criteria1:="3"
Set rng = Intersect(Range("F2:F" & Cells(Rows.Count, "F").End(xlUp).Row) _
    .SpecialCells(xlCellTypeVisible).EntireRow, [A:X])
Rows(1).Delete
rng.Select
End Sub

Thank you so much! It works!
 
Upvote 0
Well I'm glad you have a answer now.
I was not aware till now what your ultimate goal was. You never explained that in your original post
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,048
Members
448,543
Latest member
MartinLarkin

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