Code for multiple select of cells

[L. Howard]

Discounting the good advice that you seldom ever have to select cells to work with them...

How would you "select" all the cells on a sheet (.used range I suppose) of an input box entry.

The code equivalent of "ctrl key + click" on each cell with the number 5 in it.

The macro recorder gives you a bunch of cell address's, I want code to just select all the cells with 5 in them.

Thanks,
Howard

 

[GS]

One way...

Sub FindMyVal()
Dim n&, k&, sz$

ReDim vArray(1 To WorksheetFunction.CountIf(ActiveSheet.UsedRange,
5))
For n = LBound(vArray) To UBound(vArray)
With ActiveSheet.UsedRange
For k = 1 To .Cells.Count
If .Cells(k) = 5 And InStr(sz, .Cells(k).Address) = 0 Then
sz = sz & "," & .Cells(k).Address: Exit For
End If
Next 'k
End With 'ActiveSheet.UsedRange
Next 'n
' sz = Replace(Mid(sz, 2), ",", ", ")
Range(Replace(Mid(sz, 2), ",", ", ")).Select
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[L. Howard]

One way...

Sub FindMyVal()
Dim n&, k&, sz$

ReDim vArray(1 To WorksheetFunction.CountIf(ActiveSheet.UsedRange,
5))
For n = LBound(vArray) To UBound(vArray)
With ActiveSheet.UsedRange
For k = 1 To .Cells.Count
If .Cells(k) = 5 And InStr(sz, .Cells(k).Address) = 0 Then
sz = sz & "," & .Cells(k).Address: Exit For
End If
Next 'k
End With 'ActiveSheet.UsedRange
Next 'n
' sz = Replace(Mid(sz, 2), ",", ", ")
Range(Replace(Mid(sz, 2), ",", ", ")).Select
End Sub

Thanks, Garry.

I thought this to be an easier task until I flailed about with hapless attempts.

The only thing I got correct in my mind as to how to do this was to read the desired cells (containing 5) into an array.

With your code:

If the UsedRange has 8 cells with the number 5 in them, we have an 8 element vArray.

Then for each cell in the UsedRange, the If statement must = 5 and return 0 from the InStr query for the cell address to be remembered in sz.

If .Cells(k) = 5 And InStr(sz, .Cells(k).Address) = 0 Then
sz = sz & "," & .Cells(k).Address: Exit For
End If

I don't get the InStr portion and sz.

But it sure does work.

Howard

 

[GS]

Then for each cell in the UsedRange, the If statement must = 5 and

return 0 from the InStr query for the cell address to be remembered
in sz.

If .Cells(k) = 5 And InStr(sz, .Cells(k).Address) = 0 Then
sz = sz & "," & .Cells(k).Address: Exit For
End If

I don't get the InStr portion and sz.

This adds the cell address to sz if it's value matches the criteria,
only if the address is not already there. Var sz holds the addresses so
they can be formatted correctly to pass as a valid list for Range().

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[L. Howard]

This adds the cell address to sz if it's value matches the criteria,
only if the address is not already there. Var sz holds the addresses so
they can be formatted correctly to pass as a valid list for Range().

Okay, makes some sense to me now. Thanks.

Here is a slightly modified version I intend to pass on unless there is already a solution provided. (Been chasing this for most of a day.)

Howard

Private Sub Worksheet_Change(ByVal Target As Range)
'/ by Garry MS Public Prog.

Application.EnableEvents = False

If IsNumeric(Target.Value) = False Then
Range("F2").Select
MsgBox "Must be number!"
Range("F1").Activate
Application.EnableEvents = True
Exit Sub
End If

If Intersect(Target, Range("F1")) Is Nothing Then Exit Sub

Dim aNum As Long
Dim n&, k&, sz$

aNum = Range("F1")

ReDim vArray(1 To WorksheetFunction.CountIf(ActiveSheet.UsedRange, aNum))
For n = LBound(vArray) To UBound(vArray)
With ActiveSheet.UsedRange
For k = 1 To .Cells.Count
If .Cells(k) = aNum And InStr(sz, .Cells(k).Address) = 0 Then
sz = sz & "," & .Cells(k).Address: Exit For
End If
Next 'k
End With 'ActiveSheet.UsedRange
Next 'n
'sz = Replace(Mid(sz, 2), ",", ", ")
Range(Replace(Mid(sz, 2), ",", ", ")).Select

Application.EnableEvents = True

End Sub

 

[L. Howard]

I meant to mention that I feel the error check for non numeric entry is a bit clunky.

Seems something has to be selected or a previous number will leave all the values of it selected on the sheet after a non number is entered.

Howard

 

[L. Howard]

I meant to mention that I feel the error check for non numeric entry is a bit clunky.

Seems something has to be selected or a previous number will leave all the values of it selected on the sheet after a non number is entered.

Howard

Maybe this would be better.

If IsNumeric(Target.Value) = False Then
Range("F1").Select
MsgBox "Must be number!"
Range("F1").ClearContents
Application.EnableEvents = True
Exit Sub
End If

 

[Claus Busch]

Hi Howard,

Am Sun, 26 Oct 2014 14:38:35 -0700 (PDT) schrieb L. Howard:

How would you "select" all the cells on a sheet (.used range I suppose) of an input box entry.

another suggestion:

Sub MultiSelect()
Dim rngBig As Range, rngC As Range

For Each rngC In ActiveSheet.UsedRange
If rngC.Value = 5 And rngBig Is Nothing Then
Set rngBig = rngC
ElseIf rngC = 5 And Not rngBig Is Nothing Then
Set rngBig = Union(rngBig, rngC)
End If
Next
rngBig.Select

End Sub


Regards
Claus B.

 

[Claus Busch]

Hi again,

Am Mon, 27 Oct 2014 08:21:59 +0100 schrieb Claus Busch:

another suggestion:

another suggestion:

Sub MultiSelect2()
Dim rngBig As Range, c As Range
Dim Firstaddress As String

With ActiveSheet.UsedRange
Set c = .Find(5, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
Firstaddress = c.Address
Do
If rngBig Is Nothing Then
Set rngBig = c
Else
Set rngBig = Union(rngBig, c)
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> Firstaddress
End If
End With
rngBig.Select
End Sub


Regards
Claus B.

 

[L. Howard]

Hi again,

Am Mon, 27 Oct 2014 08:21:59 +0100 schrieb Claus Busch:


another suggestion:

Sub MultiSelect2()
Dim rngBig As Range, c As Range
Dim Firstaddress As String

With ActiveSheet.UsedRange
Set c = .Find(5, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
Firstaddress = c.Address
Do
If rngBig Is Nothing Then
Set rngBig = c
Else
Set rngBig = Union(rngBig, c)
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> Firstaddress
End If
End With
rngBig.Select
End Sub


Regards
Claus B.
--

Thanks Claus.

Really have some good stuff to work with.

Regards,
Howard

 

[GS]

How about using DataValidation to handle input data type and going
with...

Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("F1") Then FindMyVal Target.Value
End Sub

Sub FindMyVal(ValToFind&)
Dim n&, k&, sz$

n = WorksheetFunction.CountIf(ActiveSheet.UsedRange, ValToFind)
If n = 0 Then Exit Sub Else ReDim vArray(1 To n)

' Application.EnableEvents = False
For n = LBound(vArray) To UBound(vArray)
With ActiveSheet.UsedRange
For k = 1 To .Cells.Count
If .Cells(k) = ValToFind _
And InStr(sz, .Cells(k).Address) = 0 Then
sz = sz & "," & .Cells(k).Address: Exit For
End If
Next 'k
End With 'ActiveSheet.UsedRange
Next 'n
Range(Replace(Mid(sz, 2), ",", ", ")).Select
End If 'n > 0
' Application.EnableEvents = True
End Sub

...where FindMyVal resides in a standard module. I'm not sure why you
toggle EnableEvents unless there's executable code in _SelectionChange.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[GS]

Forgot to delete this line...

End If 'n > 0

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[L. Howard]

Hi Garry and Claus,

I am using the range A1:H50 testing. All cells filled with 5.

Claus's Sub MultiSelect() code all cells selected in a blink.

Claus's Sub MultiSelect2() code all cells selected in blink & 1/2.

Garry's code Sub FindMyVal() errors out with the full range. Reduce cells around to about 30 - 40 works okay.

Glad to have all the options. Thanks.

Howard

 

[GS]

Hi Garry and Claus,

I am using the range A1:H50 testing. All cells filled with 5.

Claus's Sub MultiSelect() code all cells selected in a blink.

Claus's Sub MultiSelect2() code all cells selected in blink & 1/2.

Garry's code Sub FindMyVal() errors out with the full range. Reduce
cells around to about 30 - 40 works okay.

Glad to have all the options. Thanks.

Howard

Claus has a better suggested approach! My use of the range defined with
a string of addresses is limited to a small number of args. In the case
of your test area being contiguous and identical values, using my
approach doesn't make sense because the entire area can be selected
with 2 keyboard strokes (Ctrl+Shift+[dn]

arrow keys!

The revised version (also in a blink)...

Sub FindMyVal(ValToFind&)
Dim n&, k&, sz$, rng As Range

n = WorksheetFunction.CountIf(ActiveSheet.UsedRange, ValToFind)
If n = 0 Then Exit Sub

With ActiveSheet.UsedRange
If n = .Cells.Count Then .Select: Exit Sub

For n = 1 To .Cells.Count
If .Cells(n) = ValToFind And rng Is Nothing Then
Set rng = .Cells(n)
ElseIf .Cells(n) = ValToFind And Not rng Is Nothing Then
Set rng = Union(rng, .Cells(n))
End If
Next 'n
End With 'ActiveSheet.UsedRange
rng.Select
End Sub

Thanks to Claus...

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion​

 

[Claus Busch]

Hi Howard,

Am Mon, 27 Oct 2014 03:05:19 -0700 (PDT) schrieb L. Howard:

Claus's Sub MultiSelect() code all cells selected in a blink.

Claus's Sub MultiSelect2() code all cells selected in blink & 1/2.

I wondered about your answer because I thought the Find method is faster
than a For each loop.
But you are correct. Good to know for the future ;-)


Regards
Claus B.

 

[L. Howard]

Many thanks, guys!!

I now have a-Blink, a-Wink & a-Nod codes.

Regards,
Howard

 

[GS]

Many thanks, guys!!

I now have a-Blink, a-Wink & a-Nod codes.

Regards,
Howard

You're welcome! IMO, using Union() is the best way to go for building a
range object of disjointed cells!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion