Selecting Cells Advanced

[Johnnydotcom]

Hello All Forum Users Johnnydotcom back with another problem to solve.

I have a nice Worksheet with groups running down the side, which in turn adds 4 empty rows between each part number.

I have been challenged with selecting the part numbered cells only and then require that the selected range drops down for each separate selection by 1.

Below is an example of what i would like to achieve

the left image is manually selected by a user and the right image is what happens when a macro is run.

what I use this for after this event is complex and so I will not go into detail at this stage.

at this stage i am thinking loops, offset, resize, etc.

3148831489

[jdelano]

This isn't clear (maybe it is just me). Your current worksheet inserts the 4 rows below each part number, then someone enters the information below the part numbers? The info with the LSR, FOLD, and GALV (obviously not evert part number has all 3) after which the cell below the part number needs to have a grey fill added to it?

Does the grey fill need to happen directly after you create the 4 rows or after they input the other entries?

[Johnnydotcom]

A User Selects the three Bold Part Numbers a Macro then runs to select the next cells below each selection.

if i use the code.


Sub Macro8()
Dim cell As Variant
Dim ws As Worksheet
Dim numrows As Long
Set ws = Worksheets("Adams Sheet")
For Each cell In Selection.Cells
Selection.offset(1).Select
Next
End Sub


it almost works but does not keep the Manual selection selected

[jdelano]

Okay, so you need to both color the cell below and also, reselect the cells that the user selected before running the macro.

If so, give this a try:



Dim cel As Range
Dim selectedRange As Range
Dim preSelectedCells As String


Set selectedRange = Application.Selection

' loop through the selected cells and fill the cells below it
' with a grey color
For Each cel In selectedRange.Cells
cel.Offset(1, 0).Interior.Color = RGB(220, 220, 220)

' keep a list of the cells the user had selected so they can be reselected
preSelectedCells = preSelectedCells & cel.Address & ","
Next cel

' move the trailing coma
preSelectedCells = Left(preSelectedCells, Len(preSelectedCells) - 1)

' reselect the previously selected cells
ActiveSheet.Range(preSelectedCells).Select

[Johnnydotcom]

No Jdelano, there is no coloring of any cells just the selecting of the cells.

your code is close i think,

[p45cal]

Sub blah()
'Set originalActiveCell = ActiveCell
Set newSelection = ActiveCell
For Each are In Selection.Areas
Set newSelection = Union(newSelection, are, are.Offset(1))
Next are
newSelection.Select
'originalActiveCell.Activate
End Sub
Uncomment the commented-out lines if you want to retain the original active cell active.

[Johnnydotcom]

Hello I revised your code, the macro now moves through the cells below each selection, and I could work with it but It would be better for the rest of the code if it could select the corresponding cells below keeping the already selected cells selected at the same time.


Sub test()


Dim cel As range
Dim selectedRange As range
Dim preSelectedCells As String


Set selectedRange = Application.Selection

For Each cel In selectedRange.Cells
cel.offset(1, 0).Select

' keep a list of the cells the user had selected so they can be reselected
preSelectedCells = preSelectedCells & cel.Address & ","
Next cel

' move the trailing coma
preSelectedCells = Left(preSelectedCells, Len(preSelectedCells) - 1)

' reselect the previously selected cells
ActiveSheet.range(preSelectedCells).Select

End Sub


31490

[Johnnydotcom]

Hello P45cal,

Perfect, just what i was after, cheers P45cal.

i revised the code for further selection, see below.


Sub test2()


Dim newSelection As range


'Set originalActiveCell = ActiveCell
Set newSelection = ActiveCell
For Each are In Selection.Areas
Set newSelection = Union(newSelection, are, are.offset(1))
Set newSelection = Union(newSelection, are, are.offset(2))
Next are
newSelection.Select
'originalActiveCell.Activate




End Sub

[Johnnydotcom]

Thanks to both Jdelano and P45cal,

both of your codes and suggestions are great, keep up the good work.

[p45cal]

Set newSelection = Union(newSelection, are, are.Offset(1).Resize(2))

[p45cal]

or shorter (but it won't increase the size with repeated running of the code):
Set newSelection = Union(newSelection, are.Resize(3))

[Johnnydotcom]

Quick one both,

Unfortunately P45cal your


Set originalactivecell = Activecell

and


OriginalActivecell.activate

does not work

Jdelanos code


' keep a list of the cells the user had selected so they can be reselected
preSelectedCells = preSelectedCells & cel.Address & ","
Next cel

' move the trailing coma
preSelectedCells = Left(preSelectedCells, Len(preSelectedCells) - 1)

' reselect the previously selected cells
ActiveSheet.range(preSelectedCells).Select

Does work

i am using check boxes on a userform to activate the cells if i unselect all checkboxes i would like it to go back to the original selection?

[p45cal]

Unfortunately P45cal your

Set originalactivecell = Activecell
and

OriginalActivecell.activate
does not work
Well, I tested it here before posting.
Perhaps because
is manually selected by a user isn't accurate?


i am using check boxes on a userform to activate the cellsMaybe attach a version of the workbook and userform. There are a number of reasons that part might not work.

[Johnnydotcom]

Hi P45cal, i cannot post the workbook for Data protection act reasons, The work flow is like this, the Cells are originally selected manually by a user, then the useform is started, the checkboxes are used to activate the macro

I test all macros without userform first to prove the macro. what happens my end when testing like this is I manually select the cells as shown in my images, i run your code without the two extra codes and the function performs just as i asked, however, when i turn on the two extra codes, it separates the selection from a range to individual selections, not going back to the originally selected cells.

below i show the images of the result when testing with out the userform.

First test without comments


Sub blah()
'Set originalActiveCell = ActiveCell
Set newSelection = ActiveCell
For Each are In Selection.Areas
Set newSelection = Union(newSelection, are, are.offset(1))
Next are
newSelection.Select
'originalActiveCell.Activate
End Sub


result

Activecell = top selection
31491


Sub blah()
Set originalActiveCell = ActiveCell
Set newSelection = ActiveCell
For Each are In Selection.Areas
Set newSelection = Union(newSelection, are, are.offset(1))
Next are
newSelection.Select
originalActiveCell.Activate
End Sub


Activecell = Bottom selection
31492

[p45cal]

I think there's been a misunderstanding; when I said:

Uncomment the commented-out lines if you want to retain the original active cell active.it was because I noted in your first post that the active cell in both pictures remained the same, at the cell containing 1717-803-12-01-02.
When any selection of cells is made, there's always 1 cell which is the active cell. Which cell that is depends on how the user made the selection. All my 2 lines of code do is to keep that cell as the active cell after the new selection is made.
So you want to go
back to the originally selected cells then set a variable to whole selection before doing any reselecting:

Set OriginalSelection = Selection
'Set originalActiveCell = ActiveCell
Set newSelection = ActiveCell
For Each are In Selection.Areas
Set newSelection = Union(newSelection, are.Resize(3))
Next are
newSelection.Select
Z = MsgBox("Want the original selection back?", vbYesNo)
If Z = 6 Then OriginalSelection.Select
'originalActiveCell.Activate

[Johnnydotcom]

i cracked it


If Me.CheckBox1 = True Then


Set OriginalActivecell = Selection
Set newSelection = ActiveCell
For Each are In Selection.Areas
Set newSelection = Union(newSelection, are, are.Offset(1))
Next are
newSelection.Select


Else
OriginalActivecell.Select
End If

[p45cal]

That can be shortened to:

If Me.CheckBox1 = True Then
Set newSelection = ActiveCell
For Each are In Selection.Areas
Set newSelection = Union(newSelection, are, are.Offset(1))
Next are
newSelection.Select
End If