Using ActiveCell to Enter Data, Sort, and Move Cells.

[mlarson]

Hi all! I have a question I hope you can help me with. Thanks in advance for your help!

I would like a code that can do all of this in one Run… I’d like it to use ActiveCell (and not a specific address like A2 or B4). So, when I run the macro, it starts at the active cell and enters ten numbers vertically down staring with 1 in the active cell, then 3 in the row beneath it, 5 in the next row, then in subsequent rows 7, 9, 2, 4, 6, 8, and 10.

Then sort those 10 rows that we just entered numbers in (in Column A) but also include column B and C in that sort. So, for example, if the ActiveCell is A5, then the range would be A5:C14.

Then move to the right one cell the words in Column C (within the range) that are in same row as the numbers 2, 4, 6, 8, and 10 in Column A, so that the words in those rows of Column C go to Column D.

Finally, make those in Column B within that range (not the entire column B) unbold, and make those in Column C within that range bold.

I hope I explained this clearly. Again, thanks for your help!

 

[MARK858]

With A6 being the activecell the code below turns

Book1.xlsb
	A	B	C	D
4
5
6			A
7			B
8			C
9			D
10			E
11			F
12			G
13			H
14			I
15			J
Sheet1

into

Book1.xlsb
	A	B	C	D	E
4
5
6	1		A
7	3		B
8	5		C
9	7		D
10	9		E
11	2		F
12	4		G
13	6		H
14	8		I
15	10		J
Sheet1

Then

Book1.xlsb
	A	B	C	D	E
4
5
6	1		A
7	2			F
8	3		B
9	4			G
10	5		C
11	6			H
12	7		D
13	8			I
14	9		E
15	10			J
Sheet1

Sub mlarson()
    Dim SrtRng As Range, i As Integer

    Application.ScreenUpdating = False

    ActiveCell.Resize(10) = Application.Transpose(Array(1, 3, 5, 7, 9, 2, 4, 6, 8, 10))
    Set SrtRng = ActiveCell.Resize(10, 3)

    SrtRng.Sort Key1:=SrtRng.Cells(1, 1), Order1:=xlAscending, Header:=xlNo

    For i = 2 To 10 Step 2
        SrtRng(i, 4).Value = SrtRng(i, 3).Value
        SrtRng(i, 3).ClearContents
    Next

    Application.ScreenUpdating = True

End Sub

P.S. please can you use XL2BB to post screenshots in future as I (like many) don't want to have to retype your data

 

[mlarson]

P.S. please can you use XL2BB to post screenshots in future as I (like many) don't want to have to retype your data

Ugh, sorry about that and apologies for that oversight on my part.

And thank you for the code, works very well! Is there something I could add to it to make the words that end up in Column D within the range (not the entire column) to be bold? And can I make sure the words in Column C within the range are not bold?

 

[MARK858]

Sub mlarson2()
    Dim SrtRng As Range, i As Integer

    Application.ScreenUpdating = False

    ActiveCell.Resize(10) = Application.Transpose(Array(1, 3, 5, 7, 9, 2, 4, 6, 8, 10))
    Set SrtRng = ActiveCell.Resize(10, 3)

    SrtRng.Sort Key1:=SrtRng.Cells(1, 1), Order1:=xlAscending, Header:=xlNo

    For i = 2 To 10 Step 2
        SrtRng(i, 4).Value = SrtRng(i, 3).Value
        SrtRng(i, 3).ClearContents
    Next
    
    SrtRng(1, 4).Resize(10).Font.Bold = True
    SrtRng(1, 3).Resize(10).Font.Bold = False
    

    Application.ScreenUpdating = True

End Sub

 

[johnnyL]

This is what I came up with:

Sub Test()
'
    Dim DataRange       As Range
    Dim NumberArray     As Variant
'
    NumberArray = Array(1, 3, 5, 7, 9, 2, 4, 6, 8, 10)
    Set DataRange = Selection.Resize(UBound(NumberArray) + 1, 4)
'
    Selection.Resize(UBound(NumberArray) + 1) = Application.Transpose(NumberArray)
'
    With Range(Selection.Offset((UBound(NumberArray) + 1) / 2, 2).Address & ":" & Selection.Offset(UBound(NumberArray), 2).Address)
        .Font.FontStyle = "Bold"
        .Insert Shift:=xlToRight
    End With
'
    DataRange.Sort Key1:=Range(Selection.Address), Order1:=xlAscending, Header:=xlNo
End Sub

 

[mlarson]

Works perfectly, Mark858, thank you!

 

[MARK858]

You're welcome.
The code posted by @johnnyL should be faster if you are dealing with much larger data sets than you have posted. It just needs to cater for the last condition that you have added

And can I make sure the words in Column C within the range are not bold?

 

[johnnyL]

You're welcome.
The code posted by @johnnyL should be faster if you are dealing with much larger data sets than you have posted. It just needs to cater for the last condition that you have added

Sub Test2()
'
    Dim NumberArray     As Variant
'
    NumberArray = Array(1, 3, 5, 7, 9, 2, 4, 6, 8, 10)
'
    Selection.Resize(UBound(NumberArray) + 1) = Application.Transpose(NumberArray)
'
    With Range(Selection.Offset((UBound(NumberArray) + 1) / 2, 2).Address & ":" & Selection.Offset(UBound(NumberArray), 2).Address)
        .Font.FontStyle = "Bold"
        .Insert Shift:=xlToRight
    End With
'
    Selection.Resize(UBound(NumberArray) + 1, 4).Sort Key1:=Range(Selection.Address), Order1:=xlAscending, Header:=xlNo
    Selection.Resize(UBound(NumberArray) + 1, 3).Font.FontStyle = "Regular"
End Sub

Better?

 

[MARK858]

Better?

I wasn't criticizing. It was a new condition the OP added that you probably hadn't seen while writing the code.

 

[johnnyL]

No worries. Didn't receive it as criticizing.