PDA

View Full Version : Solved: Automatically rearrange columns



Sir Babydum GBE
06-20-2005, 03:28 AM
Hi guys

Can someone tell me whether this is possible please - and what level of complexity would be required to do it...

The Setting

"Courses" is a reference sheet that contains the names of a bunch of training courses. The titles of the courses are all in the top row (there are about 70 of them). Underneath each course there is a list of modules that will be done in that course program.

"Delegates" will contain a list of delegates, what training courses they are on, and the modules they will be doing. Now on this sheet, the module titles run across the top row, the delegate names will appear in Column A, their Course in column B, and the modules from column C onwards. There are about 150 modules in total, and each of the courses is a combination of those 150 modules.



The Task

Each Course requires that the modules contained within it are done in a specific order - but it is not the same order for each one (the correct order appears under each heading on the "Courses" sheet). What I'm hoping to do is, on the "Delegates sheet" to be able to select a delegate, then the code will look at what training course the delegate is on. Then it should refer to the "Courses" sheet to determine the correct order of modules for the course, then arrange the columns in the delegate sheet so that the order of modules is correct, and columns containing modules that don't appear in that course are hidden.

Is this a miracle I'm asking for - or is it fairly simple?

xld
06-20-2005, 05:20 AM
Is this a miracle I'm asking for - or is it fairly simple?

If I understand correctly, it is fairly simple


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iLastrow As Long
Dim iLastCol As Long
Dim i As Long
Dim iColumn As Long

If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then
If Target.Count = 1 Then
If Target.Value <> "" Then
iLastCol = Me.Cells(Target.Row, Columns.Count).End(xlToLeft).Column
With Worksheets("Courses")
On Error Resume Next
iColumn = Application.Match(Target.Offset(0, 1).Value, .Rows("1:1"), 0)
On Error GoTo 0
If iColumn > 0 Then
iLastrow = .Cells(Rows.Count, iColumn).End(xlUp).Row
Application.AddCustomList ListArray:=.Cells(2, iColumn).Resize(iLastrow - 1)
Range(Cells(Target.Row, "C"), Cells(Target.Row, iLastCol)).Sort _
Key1:=Cells(ActiveCell.Row, "C"), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=Application.CustomListCount, _
MatchCase:=False, _
Orientation:=xlLeftToRight
Application.DeleteCustomList Application.CustomListCount
End If
End With
End If
End If
End If

End Sub


This is worksheet event code, which means that it needs to be placed in the Delegates worksheet code module, not a standard code module. To do this, right-click on the sheet tab, select 'the View Code option from the menu, and paste the code in.

Sir Babydum GBE
06-20-2005, 06:08 AM
XLD - Thanks so much!

I have a question about your code, (which I'm about to test):

If I move either the column on the delegates sheet that contains their Course name - or the first Column with a module - where in your code would I amend that?

For instance, if the column with the delegates course moved to E, and the Modules started in, say, H - what would change in the code?

Another thing I need to say is that module descriptions wouldn't appear next to each delegate. The modules are headers, then in the rows next to the delegates the blank cells will be populate as and when delegates actually do their modules. I'm not sure this affects your code, but I should have explained it in the OP

Thanks so much for your help. :)

xld
06-20-2005, 06:36 AM
If I move either the column on the delegates sheet that contains their Course name - or the first Column with a module - where in your code would I amend that?

For instance, if the column with the delegates course moved to E, and the Modules started in, say, H - what would change in the code?

This version should be more flexible and self-explanatory for that


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const colNames As String = "a:a"
Const colCourses As String = "1:1"
Const colModules As String = "C"
Const colCourse As String = "B"
Dim iLastrow As Long
Dim iLastCol As Long
Dim i As Long
Dim iColumn As Long

If Not Intersect(Target, Me.Range(colNames)) Is Nothing Then
If Target.Count = 1 Then
If Target.Value <> "" Then
iLastCol = Me.Cells(Target.Row, Columns.Count).End(xlToLeft).Column
With Worksheets("Courses")
On Error Resume Next
iColumn = Application.Match(Cells(Target.Row, colCourse).Value, .Rows(colCourses), 0)
On Error GoTo 0
If iColumn > 0 Then
iLastrow = .Cells(Rows.Count, iColumn).End(xlUp).Row
Application.AddCustomList ListArray:=.Cells(2, iColumn).Resize(iLastrow - 1)
Range(Cells(Target.Row, colModules), Cells(Target.Row, iLastCol)).Sort _
Key1:=Cells(ActiveCell.Row, colModules), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=Application.CustomListCount + 1, _
MatchCase:=False, _
Orientation:=xlLeftToRight
Application.DeleteCustomList Application.CustomListCount
End If
End With
End If
End If
End If

End Sub




Another thing I need to say is that module descriptions wouldn't appear next to each delegate. The modules are headers, then in the rows next to the delegates the blank cells will be populate as and when delegates actually do their modules. I'm not sure this affects your code, but I should have explained it in the OP

Don't really understand how that c an be. Each course will have different module names? So how can they be headers. My code won't work as it stands for that, and I c an't say how to change it as I don't now understanmd the data.

Sir Babydum GBE
06-20-2005, 07:17 AM
As always, I really appreciate your help and patience.

I have attached an example spreadsheet with a textbox containing the explanation of what i hope to achieve. Please let me know if this is helpful. :)

xld
06-20-2005, 08:44 AM
The modules aligned to the courses are repeated in some instances, and also in the delegate heading row. This throws the sort out, so I don't think it can be done with the data as is.

Sir Babydum GBE
06-20-2005, 08:57 AM
Ah! These repetitions are errors and will be edited. Can it be done if we assume that there are no duplications?

Thanks

xld
06-20-2005, 10:45 AM
Ah! These repetitions are errors and will be edited. Can it be done if we assume that there are no duplications?

I wish you had done that before <vbg> I spent hours (well minutes) thinking there was something wrong with the code.

Okay, if I understand correctly, this is what you want


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const colNames As String = "A:A"
Const colCourses As String = "1:1"
Const colModules As Long = 3
Const colCourse As String = "B"
Dim sColumns As String
Dim iLastrow As Long
Dim nColumns As Long
Dim nCourses As Long
Dim i As Long
Dim iColumn As Long

If Not Intersect(Target, Me.Range(colNames)) Is Nothing Then
If Target.Count = 1 Then
If Target.Value <> "" Then
With Worksheets("Courses")
On Error Resume Next
iColumn = Application.Match(Cells(Target.Row, colCourse).Value, .Rows(colCourses), 0)
On Error GoTo 0
If iColumn > 0 Then
nCourses = .Cells(Rows.Count, iColumn).End(xlUp).Row - 1
Application.AddCustomList ListArray:=.Cells(2, iColumn).Resize(nCourses)
nColumns = Cells(1, Columns.Count).End(xlUp).Column
sColumns = ColumnLetter(colModules) & ":" & ColumnLetter(nColumns)
Columns(sColumns).Hidden = False
Columns(sColumns).Sort _
Key1:=Cells(1, colModules), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=Application.CustomListCount + 1, _
MatchCase:=False, _
Orientation:=xlLeftToRight
sColumns = ColumnLetter(colModules + nCourses) & ":IV"
Columns(sColumns).Hidden = True
Application.DeleteCustomList Application.CustomListCount
End If
End With
End If
End If
End If

End Sub

'-----------------------------------------------------------------
Function ColumnLetter(Col As Long)
'-----------------------------------------------------------------
Dim sColumn As String
sColumn = Split(Columns(Col).Address(, False), ":")(1)
ColumnLetter = sColumn
End Function


I see you used Jimmy Hill. Are you in the UK then?

Sir Babydum GBE
06-20-2005, 02:06 PM
xld,

Once again, Thank you - for your perseverance.


I wish you had done that before <vbg> I spent hours (well minutes) thinking there was something wrong with the code.Sorry, I didn't realise the duplicates were there until you told me!



I see you used Jimmy Hill. Are you in the UK then?I'm from Sunny Cardiff - where most of the new Doctor Who was filmed, in fact.

You?

mdmackillop
06-20-2005, 02:24 PM
Hi Babydum,
I see from your Local Time that you're 8 hours behind Bonnie Scotland. Is this a side effect of the visit from the famous Time Lord?

Sir Babydum GBE
06-20-2005, 02:31 PM
Hi Babydum,
I see from your Local Time that you're 8 hours behind Bonnie Scotland. Is this a side effect of the visit from the famous Time Lord?
Perhaps it's me not setting my profile properly. I'll have a go at changing it - if that doesn't work I guess we'll have to blame it on The Doctor. What do you think of the new series? (I guess we should carry this conversation on elsewhere - but, for now...

Any of you American cousins seen the new series?

mdmackillop
06-20-2005, 02:37 PM
If you set your country, you can get the flags as well!

Edit:
I see you've done that. Maybe the time shift will catch up later.

I'm aware of the new series, but not watched it.

xld
06-20-2005, 04:09 PM
I'm from Sunny Cardiff - where most of the new Doctor Who was filmed, in fact.

I am of Welsh stock, my name is Lover of Horses (I am sure you will know from that), but it was my grandfather who went east, and I am fully anglicised.

BTW - have we solved the problem?

Sir Babydum GBE
06-20-2005, 04:27 PM
Blasted English! ;)

Yes thank you, this solves the problem nicely. Though I see potential for the sheet and may have some more questions in the near future about improvements to the structure.

You're a star.l Thanks.

Sir Babydum GBE
06-21-2005, 08:09 AM
Darn it.

This is not working at my work PC - which is XL97.

The line sColumn = Split(Columns(Col).Address(, False), ":")(1) has the word "Split" highlighted and... i can't remember what the error message was because it won't do it again. It gives me a new error on the line:
Application.AddCustomList ListArray:=.Cells(2, iColumn).Resize(nCourses)
The message is "Method Application.AddCustomList' of object ' _Application Failed"

Any ideas? (can someone please unmark this as solved?

Cheers

xld
06-21-2005, 08:24 AM
This is not working at my work PC - which is XL97.

Of course it doesn't, Split wasn't introduced until XL 2000 :).

Add this code to the other bits

#If VBA6 Then
#Else
'-----------------------------­------------------------------­------
Function Split(Text As String, _
Optional Delimiter As String = ",") As Variant
'-----------------------------­------------------------------­------
Dim i As Long
Dim sFormula As String
Dim aryEval
Dim aryValues

If Delimiter = vbNullChar Then
Delimiter = Chr(7)
Text = Replace(Text, vbNullChar, Delimiter)
End If

sFormula = "{""" & Application.Substitute(Text, Delimiter, """,""") & """}"
aryEval = Evaluate(sFormula)
ReDim aryValues(0 To UBound(aryEval) - 1)
For i = 0 To UBound(aryValues)
aryValues(i) = aryEval(i + 1)
Next

Split = aryValues

End Function
#End If

Sir Babydum GBE
06-21-2005, 08:29 AM
Thanks xla

Different error now

sColumns = ColumnLetter(colModules) & ":" & ColumnLetter(nColumns)

Sub or function not defined

xld
06-21-2005, 08:43 AM
Thanks xla

xld. xla is an add-in:doh:


Different error now

Replace everything in that worksheet code module with this. I have also fixed a problem that can arise when it fails and leaves custom lists hanging around.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const colNames As String = "A:A"
Const colCourses As String = "1:1"
Const colModules As Long = 3
Const colCourse As String = "B"
Dim sColumns As String
Dim iLastrow As Long
Dim nColumns As Long
Dim nCourses As Long
Dim i As Long
Dim iColumn As Long

If Not Intersect(Target, Me.Range(colNames)) Is Nothing Then
If Target.Count = 1 Then
If Target.Value <> "" Then
With Worksheets("Courses")
On Error Resume Next
iColumn = Application.Match(Cells(Target.Row, colCourse).Value, .Rows(colCourses), 0)
On Error GoTo 0
If iColumn > 0 Then
nCourses = .Cells(Rows.Count, iColumn).End(xlUp).Row - 1
On Error Resume Next
Application.AddCustomList ListArray:=.Cells(2, iColumn).Resize(nCourses)
On Error GoTo 0
nColumns = Cells(1, Columns.Count).End(xlUp).Column
sColumns = ColumnLetter(colModules) & ":" & ColumnLetter(nColumns)
Columns(sColumns).Hidden = False
Columns(sColumns).Sort _
Key1:=Cells(1, colModules), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=Application.CustomListCount + 1, _
MatchCase:=False, _
Orientation:=xlLeftToRight
sColumns = ColumnLetter(colModules + nCourses) & ":IV"
Columns(sColumns).Hidden = True
Application.DeleteCustomList Application.CustomListCount
End If
End With
End If
End If
End If

End Sub

'-----------------------------------------------------------------
Function ColumnLetter(Col As Long)
'-----------------------------------------------------------------
Dim sColumn As String
sColumn = Split(Columns(Col).Address(, False), ":")(1)
ColumnLetter = sColumn
End Function
#If VBA6 Then
#Else
'-----------------------------­------------------------------­------
Function Split(Text As String, _
Optional Delimiter As String = ",") As Variant
'-----------------------------­------------------------------­------
Dim i As Long
Dim sFormula As String
Dim aryEval
Dim aryValues

If Delimiter = vbNullChar Then
Delimiter = Chr(7)
Text = Replace(Text, vbNullChar, Delimiter)
End If

sFormula = "{""" & Application.Substitute(Text, Delimiter, """,""") & """}"
aryEval = Evaluate(sFormula)
ReDim aryValues(0 To UBound(aryEval) - 1)
For i = 0 To UBound(aryValues)
aryValues(i) = aryEval(i + 1)
Next

Split = aryValues

End Function

Function Replace(Source As String, Find As String, Replace As String)
Dim iPos As Long
Dim sTemp As String
sTemp = Source
Do
iPos = InStr(sTemp, Find)
sTemp = Left(sTemp, iPos - 1) & Replace & Right(sTemp, Len(sTemp) - Len(Find) - iPos + 1)
Loop Until InStr(sTemp, Find) = 0
Replace97 = sTemp
End Function
#End If

Sir Babydum GBE
06-21-2005, 01:45 PM
Thanks xtc :devil:


What started as a friendly help has become a massive task - I'm so sorry!

(what does xld stand for? why do you have Venezuelan (:dunno ) flag if you're from Englishland (I was born in Yorkshire, by the way), do you hate me? And, do I have the correct number of closing parentheses in this sentence?)

I'll try the code out at work tomorrow (don't have xl97 at home). I want you to know I really appreciate your help. :clap:

If ever you're coming to Cardiff, let me know and I'll bake you a cake* - or knit you a quilt to rival Dreamboat's! (that last bit is a lie)

*For you non-brits, that?s a little English colloquialism.

xld
06-21-2005, 03:59 PM
Thanks xtc :devil:

Wasn't that a band from Swindown?



Thanks What started as a friendly help has become a massive task - I'm so sorry!

Not that massive, so no problem.


Thanks (what does xld stand for? why do you have Venezuelan (:dunno ) flag if you're from Englishland (I was born in Yorkshire, by the way), do you hate me? And, do I have the correct number of closing parentheses in this sentence?)

As mundane as eXceL Development I am afraid.

It's Chilean, and that was where I was when I joined. And I am from Wessexland, and a fervent supporter of the Wessex Liberation Front.

So you're not even Welsh! What a let-down. I hope you're not one of those taciturn, stoical, retentative Yorkshiremen? If not, I won't hate you!


I'll try the code out at work tomorrow (don't have xl97 at home). I want you to know I really appreciate your help. :clap:

If ever you're coming to Cardiff, let me know and I'll bake you a cake* - or knit you a quilt to rival Dreamboat's! (that last bit is a lie).

Good luck with it. Post back if any problems. Can you get on-line at work for further updates if necessary?

Haven't been to Cardiff for years, although my daughter has friends at the Uni there.

Sir Babydum GBE
06-22-2005, 01:59 AM
Ok,

Still not working properly here at work.

Getting the error "Unable to Set the Hidden property of the Range Class" on the line:
Columns(sColumns).Hidden = True.

I'm attaching the actual workbook now so that perhaps you can have a better Idea what's going on. The Starting columns are in different positions - but i think i sorted that in your code.

Really sorry about this, yet again, I'm beginning to feel like a little Yorkshire Terroriser!

(Also, some redundant lists were still being left in the custom lists thingy - I'm not sure that that was affecting things so I deleted the lists and started again - but i still got the error (and more redundant lists))

Oh, and what the blazes is the Wessex Liberation Front? Are you from Liberia or Wessex? Make up your mind!

xld
06-22-2005, 03:22 AM
Still not working properly here at work.

Getting the error "Unable to Set the Hidden property of the Range Class" on the line:
Columns(sColumns).Hidden = True.

What do you expect! You have a comment in cell CH1, and surely you have read this Microsoft KB article

http://support.microsoft.com?kbid=170081 (http://support.microsoft.com/?kbid=170081)
XL97: "Cannot Shift Objects Off Sheet" Error Hiding Columns

Remove the comment, and it works fine.


Really sorry about this, yet again, I'm beginning to feel like a little Yorkshire Terroriser!

Terrorist! Sabotaging those good Welsh folks.


(Also, some redundant lists were still being left in the custom lists thingy - I'm not sure that that was affecting things so I deleted the lists and started again - but i still got the error (and more redundant lists))

That shouldn't be a problem, my last amendment caters for that, but it doesn't hurt to clear them if you see them. Once it is working fine, there should be no problem.


Oh, and what the blazes is the Wessex Liberation Front? Are you from Liberia or Wessex? Make up your mind!

That is quite a mind-leap to equate Liberation with Liberia. A hundred years ago, maybe, no today.

It is just an organisation of mad, sad old gits that would like to see the Kingdom of Wessex (remember Arthur?) devolved from the UK.

Sir Babydum GBE
06-22-2005, 03:59 AM
Thanks TCP, you're a star. :bow:

So, what you're saying is "it was all your fault babydum, and being a Yorkshire boy probably doesn't help", is it?

It's all working now and I think I'll probably get the medal that you deserve!. I've put a thanks to you in the properties of the document (not allowed to put it anywhere else). I have another question, but that's about to appear in another thread because it's an entirely seperate question - though the answer will hopefully be able to be employed in the sheet you so masterfully fixed.
:beerchug:

xld
06-22-2005, 04:23 AM
Thanks TCP, you're a star.

TCP - because I disinfect the wounds inflicted by others? :)


So, what you're saying is "it was all your fault babydum, and being a Yorkshire boy probably doesn't help", is it?

No, what I am saying is that anyone who doesn't know every KB article that pertains to Excel off my heart shouldn't be let anywhere near a spreadsheet.


It's all working now and I think I'll probably get the medal that you deserve!. I've put a thanks to you in the properties of the document (not allowed to put it anywhere else).

We long-suffering developrs are well used to that, rarely do we even get the hidden thanks:(. Seriously though, I enjoyed this one. I especially liked being able to use custom lists on the fly, and will keep that one in my armoury for future use.


:beerchug:
I guess that is at least one thing they do well in Yorkshire.

Sir Babydum GBE
06-27-2005, 07:07 AM
Ok, I have another last question :)

I'm sure that this will be trickier, but you have brains and I have a pick.

In the example workbook above, the code that you ("you" being xld - in case you're not xld. If you are xld - ignore what's in these parentheses) have created sorts the columns according to the "Role" on any given line, and hides the the columns that do not need to be seen.

Can a variation of the code - run as a one off macro - put "n/a" in all the cells that would be hidden for each delegate, and "pending" for all the cells that would be visible for each delegate?

World peace is at stake again.

Ta very much

xld
06-27-2005, 08:01 AM
Ok, I have another last question :)

I'm sure that this will be trickier, but you have brains and I have a pick.

In the example workbook above, the code that you ("you" being xld - in case you're not xld. If you are xld - ignore what's in these parentheses) have created sorts the columns according to the "Role" on any given line, and hides the the columns that do not need to be seen.

Can a variation of the code - run as a one off macro - put "n/a" in all the cells that would be hidden for each delegate, and "pending" for all the cells that would be visible for each delegate?

World peace is at stake again.

Ta very much

I thought your company had done vbax a favour and banned you from playing with Excel :devil:

Your workbook has been removed from your previous post for Data protection reasons. You could mail me a copy in a PM, or post a cleaned version to workl on.

Sir Babydum GBE
06-27-2005, 08:56 AM
I thought your company had done vbax a favour and banned you from playing with Excel :devil:
Right, that's it! My oven is well and truly off. No cake for you if you visit, mr mfi! The rule isn't in yet, and after having a chat with some guys from I.S. it looks as though it's not going to be enforcable. The upshot being that it will be against policy, but if an unregistered spreadsheet is used, they won't interfere (probably), but they won't support or fix problems either. And, seeing as I have never once reported a spreadsheet fault to the coding guys - primarily because there is a four-week turnaraound on such fault reports - but rather i use great forums such as this one when I run into trouble, I think i will continue with the project.


Your workbook has been removed from your previous post for Data protection reasons. You could mail me a copy in a PM, or post a cleaned version to workl on.
Oh, that's right - it was me that removed it. here it is.

Thanks

xld
06-27-2005, 10:44 AM
Right, that's it! My oven is well and truly off. No cake for you if you visit, mr mfi!

What, no cake! This isn't a fee service you know.


The rule isn't in yet, and after having a chat with some guys from I.S. it looks as though it's not going to be enforcable. The upshot being that it will be against policy, but if an unregistered spreadsheet is used, they won't interfere (probably), but they won't support or fix problems either.

That is a more pragmatic policy. You can understand the IS guys problems, trying to sort problems on thousands of spreadsheets by thousands of different developers is a daunting task. You either enforce a rigid poiicy of central spreadsheet development, no spreadsheet development, or you get pragmatic.


Oh, that's right - it was me that removed it. here it is.


It is not quick, but you will only run iot rarely.

I don't get why you want this though, with the other code you will never see the 'n/a's :wot


Sub SettoNA()
Dim iLastCol As Long
Dim ilastRow As Long
Dim iColumn As Long
Dim iRow As Long
Dim nCourses As Long
Dim i As Long, j As Long, k As Long
Const colCourses As String = "1:1"
Const colModules As Long = 25
Const colCourse As String = "I"

Application.ScreenUpdating = False

With Worksheets("Delegates")
iLastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
ilastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To ilastRow
iColumn = 0
On Error Resume Next
iColumn = Application.Match(.Cells(i, colCourse).Value, Worksheets("Courses").Rows(colCourses), 0)
On Error GoTo 0
If iColumn > 0 Then
For j = colModules To iLastCol
iRow = 0
On Error Resume Next
iRow = Application.Match(.Cells(1, j).Value, Worksheets("Courses").Columns(iColumn), 0)
On Error GoTo 0
If iRow = 0 Then
.Cells(i, j).Value = "n/a"
End If
Next j
End If
Next i
End With

Application.ScreenUpdating = True

End Sub

Sir Babydum GBE
06-27-2005, 11:45 AM
What, no cake! This isn't a free service you know.What? Not free? I'll put the oven back on then...


That is a more pragmatic policy. You can understand the IS guys problems, trying to sort problems on thousands of spreadsheets by thousands of different developers is a daunting task. You either enforce a rigid poiicy of central spreadsheet development, no spreadsheet development, or you get pragmatic. Good put, well point.


It is not quick, but you will only run it rarely.This is precisely why I wanted it in a seperate module. But to do that potentially 10,000 time for all sites... it's worth doing if you only use it once!


I don't get why you want this though, with the other code you will never see the 'n/a's :wotWell, I wasn't sure whether n/a's would be such an issue - but i plan to do pivot reports on the whole sheet, and I thought "n/a's would be better than blanks in case we find another use for the blanks". Just trying to think ahead - which if I managed to do a bit better, there wouldn't be all these last last questions.

So thanks for that xyz, muchos gracias amigo. :friends: