Sort current usded range

[danesrood]

Hi

I am in need of hopefully a small piece of code to sort the current used range which does not have a header and the column to sort on is whichever column the cursor is currently in.

Does that make sense?

If for example the the cursor is in G45 and the current used range extends from E12 to I52 I would like that range sorted by column G.

And as does happen frequently the cursor is in E52 then the same range whould be sorted on column E.

Am I asking too much?

If this can be achieved it would save me hours during the year.

My regards from a rather sunny English day

[mancubus]

hi.
try this



Sub Sort_Activecell_CurrentRegion()
ActiveCell.CurrentRegion.Sort Key1:=ActiveCell, Order1:=xlAscending, Header:=xlNo
End Sub

[danesrood]

mancubus

Thank you, it's wonderful and will save me hours .
And in just one line of code.

Again my sincere thanks for taking the time.

[mancubus]

you are welcome.

i assume the code will be run when the worksheet which houses the range to be sorted is the activesheet.

[danesrood]

Yes

I spend a number of hours each week working on data that comes in to me where I need to re-sort the data in various ways so believe me this piece of code will work wonders for me.

In fact I have used it quite a few times this afternoon.

Again my thanks

[mancubus]

i am glad it helped.

please mark the thread as solved from thread tools dropdown (above the first message) for future references.

[danesrood]

Hi

Good morning from what will soon be a nice sunny English day – fingers crossed.

I wonder if it is possible to add a bit more functionality to the excellent line of code that you produced for me recently.

ActiveCell.CurrentRegion.Sort Key1:=ActiveCell, Order1:=xlAscending, Header:=xlYes

Some years ago somebody very kindly gave me the following code which basically sets the row height to best fit and then gives me the option to set the height to a specific size that I type in.

This code specifies the range to work on but I would like it amended slightly to work on the same region that has just been sorted by your code.

I hope that this makes sense

Sub RowHeightChange()
Dim LstRow As Long
Dim RwHt As Double
LstRow = Application.Range("C65536").End(xlUp).Row
Range("C5:H" & LstRow).Select
Cells.EntireRow.AutoFit
RwHt = Application.InputBox("Please enter the height that you want", Type:=2)
For i = 1 To LstRow
If Range("A" & i).EntireRow.RowHeight <= RwHt Then
Range("A" & i).RowHeight = RwHt
End If
Next
End Sub

Thank you

[mancubus]

please use code tags when posting your code.
# button will do it automatically. click the button code tags will be inserted. paste your code in between these tags:

[ CODE ]your code here[ /CODE ]



assuming your range's TopLeftCell is not A1, for ex C5:H49, perhaps:



Sub RangeSortAndRowHeightChange()

Dim RwHt As Double, i As Long
Dim rng As Range

Set rng = ActiveCell.CurrentRegion

rng.Sort Key1:=ActiveCell, Order1:=xlAscending, Header:=xlYes
rng.Rows.AutoFit

RwHt = Application.InputBox("Please enter the height that you want", Type:=2)

For i = (rng.Rows(1).Row) To (rng.Rows(1).Row + rng.Rows.Count - 1)
If Cells(i, rng.Columns(1).Column).RowHeight < RwHt Then 'no need for "=" sign
Cells(i, rng.Columns(1).Column).RowHeight = RwHt
End If
Next

End Sub



rng.Rows(1).Row = 5
rng.Rows.Count = 45
rng.Rows(1).Row + rng.Rows.Count - 1 = 49

Columns(1).Column = 3, which is C.

so For Next will loop from C5 to C49

[danesrood]

mancubus

Works a treat thank you so much.

Can I just ask, is it possible to add an extra value to increase Best Fit by say 2 or 3 or is that just not possible by the very nature of BestFit.

[mancubus]

you are welcome.

you mean?

RwHt = Application.InputBox("Please enter the height that you want", Type:=2) + 2

[danesrood]

No, adding an additional amount of space to BestFit

[mancubus]

the code first autofits rows, then changes these widths to user input rowheight, if they are smaller.

now you want to increase the unchanged widths by 2 points?

[danesrood]

When you put it like that it sounds dopey.

What I find is that BestFit is a bit tight for my eyes or liking so yes I have a bash at setting a size that I think will do for all 1 line rows but there are sometimes rows that consist of 2 or 3 lines of data.

Don't get me wrong what I have got now is great and I am very pleased with, I was just wondering as a step towards my perfection if it was conceivable to add a bit extra to the space created by BestFit.

[mancubus]

no. it's about vba properties and methods you may or may not familiar with. i'm having difficulty understanding your requirement.

the best way to read a multi line text in a cell (or range) without changing the column width is to set the WrapText property of that cell to True.

perhaps:


Sub RangeSortAndRowHeightChange()

Dim i As Long
Dim rng As Range

Set rng = ActiveCell.CurrentRegion

rng.Sort Key1:=ActiveCell, Order1:=xlAscending, Header:=xlYes
rng.WrapText = True

For i = (rng.Rows(1).Row) To (rng.Rows(1).Row + rng.Rows.Count - 1)
With Cells(i, rng.Columns(1).Column)
.RowHeight = .RowHeight + 2
End With
Next

End Sub

[danesrood]

Thank you for the time you have spent on this and I apologise if I am digging myself into a hole so to speak.
Your lates bit of code doesn't seem to work as in sorting the current range backwards and forwards it is increasing the height of the rows by 2 each time and in some situations the two or three line cells aren't visible.

I'm very happy to stick with your earlier code which joins your sort option which is great and the original row height code.

However if you do want to go further what I think I would like to achieve in essence is that the row height for each row is set to bestfit each time and then an extra value is added to make it easier to read and print.

[mancubus]

if the below code won't work for you, please post a sample workbook which will demonsrate both 'before' and 'after' (macro) structure of your table in two separate worksheets.

other members can post to their solutions to the thread as well.

Choose the the method for determining the additional heigth. either ask user input this number or directly assign it to the variable. i included both in the code; so delete one of them.



Sub RangeSortAndRowHeightChange()

Dim AddXtraRwHt As Double, i As Long
Dim rng As Range
Set rng = ActiveCell.CurrentRegion

rng.Sort Key1:=ActiveCell, Order1:=xlAscending, Header:=xlYes
rng.Rows.AutoFit

AddXtraRwHt = Application.InputBox("Please enter the height that you want", Type:=2)
AddXtraRwHt = 2

For i = (rng.Rows(1).Row) To (rng.Rows(1).Row + rng.Rows.Count - 1)
With Cells(i, rng.Columns(1).Column)
.RowHeight = .RowHeight + AddXtraRwHt
End With
Next

End Sub

[danesrood]

That is precisely what I was after, it's great.

I've spent an hour or so sorting various ranges in a few worksheets all over the place and it's perfect.

Thank you for spending so much time on this it's very much appreciated.

[mperrah]

just a thought,
What if you increased the font size, say by 2 or 3 pt for the sheet or activeRegion,
then ran autosize
then return the font size to before.

kind of a work around to get what your after maybe...

good luck,
-mark

[mancubus]

@danesrod
you are welcome.


@mperrah
please record a macro while you're doing it manually and share the result. :)

[mperrah]

Sorry, should have tested first.
The size up part works, but when I downsize the font the cell shrinks with it.

another try is:
for each row with data add a zero to the last used column plus 1
then up that font 2 or 4 points and make it the same color as the background (white on white)
then run the autosize.

I'll work up a sample of this tomorrow

[mperrah]

This adds a zero to the end of each row with something in column B (skips rows with nothing in B)
then ups the font size to 14 and colors the zero white so it's not noticed.
maybe helpful?

Sub testSize()

Dim lr, lc, lrM As Range
Dim tRng, tCell As Range
Dim oCell As Long
Dim ws As Worksheet

Application.ScreenUpdating = False

lr = Cells(Rows.Count, "B").End(xlUp).Row
lc = Cells(1, Columns.Count).End(xlToLeft).Column
Set tRng = Worksheets(1).Range("B1")

For oCell = 1 To lr
If Worksheets(1).Range("B" & oCell).Value <> "" Then
Set tCell = Worksheets(1).Cells(oCell, lc).Offset(, 1)
With tCell
.Value = "0"
.Font.Size = 14
.Font.Color = vbWhite
.EntireRow.AutoFit
End With
End If
Next oCell
Application.ScreenUpdating = True
End Sub
sorry took a while, was in a car wreck and have been car hunting non stop till my free rental stops being free..
cheers
-mark

[mperrah]

A little tweek,
Added an input box so the user can size up to suit.
Even better (maybe),
Noticed the font size stays associated with the cell after the contents are removed.
So added code to remove the temp text and left out the color change - no longer necessary.


Sub testSize()

Dim lr, lc, lrM, tRng, tCell As Range
Dim fSize As Variant
Dim oCell As Long
Dim ws As Worksheet

Application.ScreenUpdating = False

lr = Cells(Rows.Count, "B").End(xlUp).Row
lc = Cells(1, Columns.Count).End(xlToLeft).Column
Set tRng = Worksheets(1).Range("B1")

fSize = InputBox("How big do you want the cell padding?", "Choose Cell Paddding", 14) ' the 14 is the starting number of the input box - you can modify to suit
For oCell = 1 To lr
If Worksheets(1).Range("B" & oCell).Value <> "" Then
Set tCell = Worksheets(1).Cells(oCell, lc).Offset(, 1)
With tCell
.Value = "0"
.Font.Size = fSize
.EntireRow.AutoFit
.Value = ""
End With
End If
Next oCell
Application.ScreenUpdating = True
End Sub

if you want to reset, run this to make all the cells font size 11 again (that was my default - can be whatever you desire)

Sub makefSize11()
With Cells.Font
.Size = 11
End With
End Sub