-
Sorting a shared workbook
Hi,
I've got an excel sheet that is shared over the network and I keep logging files that are received, with the data sorted on the date (formatted as mm/dd/yyyy hh:mm). I've written a macro for sorting the data on the Time In field (just for ease of use for the others). Earlier this file was not shared and my sort command used to work fine.
This file has a few merged cells at the right, it is a cumulative table of this list. With the file now being shared and the merged cells, the sort command doesn't work. I even tried manually sorting the data, but it won't work. Is there a solution to this query?
Lynnnow
-
Lynnnow,
I havent viewed your screenshot.
I'm not an expert or even very good but i tried putting some dates in a column, i merged a few cells then tried to sort them, the error i got was that excel wants to see all cells in the range the same size...........so it seems that unfortunately you either have to unmerge the cells, sort and then merge.........or merge all the cells the same size eg. A1+B1 merge
A2+C2 merge and so on. Anyway thats what it looks like.
Hope this helps a little.
regards,
Simon
-
This sample should unmerge, sort and remerge cells in columns A-H, assuming no more than one merge cell per row.
[VBA]
Option Explicit
Sub SortMerge()
Dim m As Range, j As Long, k As Long, Rg As Range, Cel As Range
'Get last row number
j = Cells(Rows.Count, 1).End(xlUp).Row
'Colour merged cells and remove merge
For Each m In ActiveSheet.UsedRange
If m.MergeCells = True Then
m.Interior.ColorIndex = 22
m.MergeCells = False
End If
Next
'Sort data
Range("A:J").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select
'Merge coloured cells
For k = 1 To j
Set Rg = Nothing
For Each Cel In Cells(k, 1).Resize(, 10)
If Cel.Interior.ColorIndex = 22 Then
If Rg Is Nothing Then Set Rg = Cel
Set Rg = Union(Rg, Cel)
End If
Next
If Not Rg Is Nothing Then Rg.Merge
Next
End Sub
[/VBA]
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
-
Hi MD,
The code is wonderful, however, there are no merged cells that are counted in the sorting of the list. The pre-determined range is A2:I__ (whichever the last nonblank cell is) out of which the date column is Col. E. The merged cells are at the extreme right of the list. When I run the sort command, it selects all the rows in the named range, i.e. A2:IV2 right through the end of the selection. This is the bugging part that needs to be debugged.
[VBA]Sub SortList()
Dim CurrAdd As String
Dim ThisRange As Integer
Dim CompleteRange As String
CurrAdd = ActiveCell.Address(False, False, xlA1)
ThisRange = Mid(Range("A65536").End(xlUp).Address(False, False, xlA1), 2)
CompleteRange = "A2:" & "I" & Trim(Str(ThisRange))
Range(CompleteRange).Select
Selection.Sort Key1:=Range("E2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range(CurrAdd).Select
End Sub[/VBA]
The code above gets the last nonblank cell in column A and then sorts when the workbook is not shared. This functionality doesn't work when the workbook is shared.
Please help.
Lynnnow
-
This might be a bit slow. If the range to search for merged cells (Rg) can be reduced, then execution will speed up accordingly. [VBA]
Option Explicit
Sub SortMerge()
Dim m As Range, j As Long, k As Long, Rg As Range, Cel As Range
'Get last row number
j = Cells(Rows.Count, 1).End(xlUp).Row
'Colour merged cells and remove merge
For Each m In ActiveSheet.UsedRange
If m.MergeCells = True Then
m.MergeArea.Interior.ColorIndex = 22
m.MergeCells = False
End If
Next
'Sort data
Range("A:J").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select
'Merge coloured cells
For k = 1 To j
Set Rg = Nothing
For Each Cel In Cells(k, 1).Offset(, 0).Resize(, 256)
If Cel.Interior.ColorIndex = 22 Then
If Rg Is Nothing Then Set Rg = Cel
Set Rg = Union(Rg, Cel)
End If
Next
If Not Rg Is Nothing Then Rg.Merge
Next
End Sub
[/VBA]
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules