sort and then insert rows help!

[RompStar]

I am trying to start to automate this painful report that I do by hand
every monday, I kinda was noticing what manual steps I was doing and I
figure I try to automate some of it, maybe all of it with time :- )

So I wanted to do first is.

The excel sheet has 6 columns, A - F

A--------------B------------C
Date-----------Name---------Activity


D E and F have time and productivity data, but I only want to sort by A
first and then by B, this I already done, so Sort by Date, then by
Name. Then Look into column B and insert a 25 row space between the
Names if the are not the same..

Here is my VB code so far: the Sorting works (maybe there is a way to
shorten the code), but it works..

The insert 25 rows, doesn't work, so I am figuring there is something
wrong there, that's the part I need help with..


Sub FormatTablebyName()

' This one will sort the column A/B and then seperate by 25 rows column
B if name is not the same.

Dim iRow As Long
Dim lastRow As Long

lastRow = Range("A65536").End(xlUp).Row

Columns("A:F").Select
Range("F1").Activate

' Sort Column A ( Works )

Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

' Sort Column B ( Works )

Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

' Seperate Names in Column B with a 25 space row insert

For iRow = 1 To lastRow
If Cells(iRow, 2) <> Cells(iRow + 1, 2) Then
Rows(iRow + 25).Insert
lastRow = lastRow + 25
Row = iRow + 25
End If
Next iRow
End Sub

If I replace the 25 with a 1, it works perfectly for inserting the 1
row insert, but not with 25, what am I doing wrong, help this niewbie
out, thanks!

 

[Dave Peterson]

You could sort your data by both columns in one step (using that secondary sort
field).

And if you work from the bottom up, life becomes lots easier:

Option Explicit

Sub FormatTablebyName()

Dim iRow As Long
Dim lastRow As Long

With ActiveSheet
lastRow = .Range("A65536").End(xlUp).Row

.Columns("A:F").Sort _
Key1:=.Range("A1"), Order1:=xlAscending, _
Key2:=.Range("B1"), Order2:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

For iRow = lastRow To 2 Step -1
If .Cells(iRow, 2) <> .Cells(iRow - 1, 2) Then
.Rows(iRow).Resize(25).Insert
End If
Next iRow
End With

End Sub

 

[RompStar]

yep, yep, I was just waiting for you to help me, lol

I have learnd so much from you already :- ) taking advantage of a
education
reimbursement program here at work, so I started to go to college for
database administration, hopefully I will learn a lot more in the next
3-4 years :- )

Thanks a lot!

 

[RompStar]

I'll test it on monday and tell you if there is anything weird going
on, I'll step into it and follow it line by line to
learn new things, thanks.

 

[Dave Peterson]

It's a nice benefit. Take advantage of it while it's still there.

 

[RompStar]

so I commented out the insert row part of the vb code and only wanted
to see if the sorting works,
it sorts, but not correctly, it sorts the same name maybe 5 rows and
then it goes to the next,
and then it eventually starts to sort the same name again, it doens't
sort them all
in one shot and then go to the next, the sort is kinda broken apart
sort, not even all the way through ?

any ideas why ?

 

[Dave Peterson]

Record a macro when you sort by both keys.

Then modify this portion:

.Columns("A:F").Sort _
Key1:=.Range("A1"), Order1:=xlAscending, _
Key2:=.Range("B1"), Order2:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Maybe it's just swapping key1 and key2?????

 

[RompStar]

Macro 2 works, Macro 3 don't work, I noticed that when I sort by Column
A and then I repeat the sort process by column B, it works,
but if I try to sort A and B at the same time, it don't.



Sub Macro2()
'
' Macro2 Macro
'

'
Columns("A:F").Select
Range("F1").Activate
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


Selection.Sort Key1:=Range("B1"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
Sub Macro3()
'
' Macro3 Macro

'
Columns("A:F").Select
Range("F1").Activate
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Key2:=Range("B1") _
, Order2:=xlAscending, Header:=xlNo, OrderCustom:=1,
MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2:= _
xlSortNormal
Range("E25").Select
End Sub

 

[Dave Peterson]

I meant try this:

.Columns("A:F").Sort _
Key1:=.Range("B1"), Order1:=xlAscending, _
Key2:=.Range("A1"), Order2:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

So Column B becomes the primary sort and column A is the secondary sort.

 

[RompStar]

ohhhh let me try that...

 

[RompStar]

yep it worked...

Ok another question :- )

Now that I have my columns seperated by the employee name in column B
or 2, with a 25 space row insert, like in this example
I have 6 employees that I am doing a productivity report on, so there
is 6, 25 space inserts..

Now on each employees data block I guess you call it, I want to select
those blocks and sort them by the activity type which is
in column C or 3. My manual step was to highlight the effected block
of data and then sort it by column C with no headers, then
move down 25 space, and select manually the next block of data and sort
again my column C with no headers.

The 25 space is needed, because later I insert a template in there that
sums up all the numbers and presents in
into a manager view, but that's the last step, I will be happy to
automate the majority of it :- ) and I learn a lot
along the way.

See it's impossible to select columns A - F and then sort by C, because
of the 25 spaces it dones't sort it right, there is no way to
tell it to ignore the empty spaces, so I have to find the first set of
data, highlight it and sort it and so on..

This is a good one to learn I'll bet...

:- )

 

[Dave Peterson]

I would think you could just add one more key to the sort.

.Columns("A:F").Sort _
Key1:=.Range("B1"), Order1:=xlAscending, _
Key2:=.Range("A1"), Order2:=xlAscending, _
Key3:=.range("c1"), order3:=xlascending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

The next key presents a problem. You only get 3 keys per sort. So you'll have
to sort the data multiple times.

But maybe you can copy|paste using the same macro (save your work before you run
it!)

Option Explicit
Sub FormatTablebyName()

Dim iRow As Long
Dim LastRow As Long
Dim RngToCopy As Range

With Workbooks("otherworkbooknamehere.xls").Worksheets("Sheet99")
Set RngToCopy = .Range("a1:x25")
End With

With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

.Columns("A:F").Sort _
Key1:=.Range("B1"), Order1:=xlAscending, _
Key2:=.Range("A1"), Order2:=xlAscending, _
Key3:=.Range("c1"), order3:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

For iRow = LastRow + 1 To 2 Step -1
If .Cells(iRow, 2) <> .Cells(iRow - 1, 2) Then
.Rows(iRow).Resize(25).Insert
RngToCopy.Copy _
Destination:=.Cells(iRow, "A")
End If
Next iRow
End With

End Sub

 

[RompStar]

Dave thanks for all your help, let me think about all this :- )

Thank you.

 

[RompStar]

Dave do you think it would be possible to hack something up using the
End Property, xlDown ?

 

[Dave Peterson]

dim LastCell as range

with activesheet
set mylastcell = .range("a1").end(xldown)
end with

But I think that sorting the data up front would be the simplest. (I may be
mis-understanding the problem, though.)

Also, take a look at:

range("a1").currentregion

If you have nice gaps between groups, this may be sufficient.

 

[RompStar]

Dave,

Ok how about this one, this would be a time saver as well since there
can be over 1000 rows or more, basically I wanted to place a border
around all
the cells in column A - F that are not blank, so skip rows that have no
data, those probably are the 1 row spaces or 25 row spaces, well, I was
thinking
reagrdless of the row spaces, if there are any ignore them.

Sub FormatBordersAroundusedRows()

Dim iRow As Long
Dim lastRow As Long

lastRow = Range("A65536").End(xlUp).Row
Range("A1:F" & lastRow).Borders.LineStyle = xlContinuous

How do you tell it to skip the empty rows ?

 

[Dave Peterson]

Do you mean you want borders around the area or borders around each of the
cells?

I'm guessed around each of the cells--but I commented out a line that will do
the whole row--if there's something in one of the cells in that row (columns A:F
only):

Option Explicit
Sub testme01()

Dim myRngF As Range 'formulas
Dim myRngC As Range 'constants
Dim myRngB As Range 'both
Dim myBorders As Variant
Dim iCtr As Long

With ActiveSheet
Set myRngC = Nothing
Set myRngF = Nothing
On Error Resume Next
Set myRngC = .Range("A:F").Cells.SpecialCells(xlCellTypeConstants)
Set myRngF = .Range("A:F").Cells.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0

If myRngC Is Nothing Then
Set myRngB = myRngF
ElseIf myRngF Is Nothing Then
Set myRngB = myRngC
Else
Set myRngB = Union(myRngC, myRngF)
End If

If myRngB Is Nothing Then
MsgBox "No constants--no formulas!"
Exit Sub
End If

'uncomment this line if you want
'Set myRngB = Intersect(myRngB.EntireRow, .Range("A:F"))

End With

myBorders = Array(xlEdgeBottom, xlEdgeLeft, xlEdgeTop, _
xlEdgeRight, xlInsideVertical, xlInsideHorizontal)

For iCtr = LBound(myBorders) To UBound(myBorders)
With myRngB.Borders(myBorders(iCtr))
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Next iCtr

End Sub

 

[RompStar]

Ya I want it to place the border around the all cells in the A - F
range that are now blank rows,
All my columns A - F always have data if the row that has it, if it has
it, from a to F.

Anyways, I uncommented that one line you said to and wow, it works
perfectly...

Great, now I just have to figure out that 1 row spacing for the
Activity type, I want to see if I
can do that on my own with research, thanks for all the help!

I learn so much.

 

[RompStar]

Dave,

I think I figured it out with some help of a friend how to sort by
Column C with the 25 space, now I just need to figure
out how to after the sorting, how to insert a single row based on a
different employee activity, like I we did for the Names
sorting and then putting in that 25 space...

Sub FormatTablebyActivity_Row_C_STEP_2()

Dim StartRow As Long, EndRow As Long
Dim myRng As Range, LastRow As Long

LastRow = Range("A65536").End(xlUp).Row

StartRow = 1 'set to first row for initial data setup

EndRow = Range("A1").End(xlDown).Row

Do
Set myRng = Range(Cells(StartRow, "A"), Cells(EndRow, "F"))

myRng.Select

myRng.Sort Key1:=Cells(StartRow, "C"), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

StartRow = Cells(EndRow, "A").End(xlDown).Row
EndRow = Cells(StartRow, "A").End(xlDown).Row

Loop Until StartRow > LastRow

End Sub

 

[Dave Peterson]

Maybe just starting at the bottom looking for changes between cells in that
column--but ignoring the empty cells????