Community Code Challenge

Hi all, being a member of Excel Forum means you are a member of the greatest Excel community on the web, big claim?, maybe!, true?, definitely!, take a look at all the other forums available, we are one of the largest, one of the friendliest and definitely one of the most organised!

I’d like to prove the organised theory with a small challenge, below you will see the beginnings of a sub, I would ask anyone who reads this to post comment by means of adding no more than 6 lines of code to the sub and tag your insertions with a ‘ and then your initials, the code must be valid and workable and you may not change anyone else’s additions but may work them in to your code.

The idea is after the expiry date at the end of this blog we will be able to run the code on a worksheet and have something fun and tangible, each of you will get the completed worksheet mailed to you where you can further adapt or experiment and you will all get your name in a hall of fame here, you can contribute to the code 3 times but not consecutively & you may only use the variables given.

Good luck to us all!

Public Sub CCC()
Dim Rng As Range, MyCell As Range
Dim I As Long, c As Integer
Dim S As String, T As String
Dim r As Variant, m As Variant

Expiry date 20th December 2008

• Simon
• Thursday, November 13th, 2008
• Comments (10)

• Dave Morrison Says:
  04.24.48 at 4:24 am

  Dim Rng As Range, MyCell As Range
  Dim i As Long, c As Integer
  Dim S As String, T As String
  Dim r As Variant, m As Variant
  Set Rng = Worksheets(1).Range(“A1″, Range(“A” & Rows.Count).End(xlUp)) ‘dm
  For Each MyCell In Rng.Cells ‘dm
  MyCell.Font.Bold = Not MyCell.Font.Bold ‘dm
  Next MyCell ‘dm

• Simon Says:
  12.55.13 at 12:55 pm

  Public Sub CCC()
  Dim Rng As Range, MyCell As Range
  Dim i As Long, c As Integer
  Dim S As String, T As String
  Dim r As Variant, m As Variant
  Set Rng = Worksheets(1).Range(“A1″, Range(“A” & Rows.Count).End(xlUp)) ‘dm
  For Each MyCell In Rng.Cells ‘dm
  MyCell.Font.Bold = Not MyCell.Font.Bold ‘dm
  Next MyCell ‘dm
  For i = 1 To Range(“A” & Rows.Count).End(xlUp).Row
  Range(“A” & i).Copy Destination:=Range(“A” & i).Offset(0, i)
  Next i
  End Sub

• Dave Morrison Says:
  15.56.16 at 3:56 pm

  Public Sub CCC()
  Dim Rng As Range, MyCell As Range
  Dim i As Long, c As Integer
  Dim S As String, T As String
  Dim r As Variant, m As Variant
  Set Rng = Worksheets(1).Range(“A1″, Range(“A” & Rows.Count).End(xlUp)) ‘dm
  For Each MyCell In Rng.Cells ‘dm
  MyCell.Font.Bold = Not MyCell.Font.Bold ‘dm
  Next MyCell ‘dm
  For i = 1 To Range(“A” & Rows.Count).End(xlUp).Row
  Range(“A” & i).Copy Destination:=Range(“A” & i).Offset(0, i)
  Next i
  S = MsgBox(“Hello,the number of items in column 1 is ” & Rng.Count & vbCrLf & “Do you wish to add these items to Shee 2 ?”, 68, “For Your Information”)
  If S = vbYes Then
  Rng.Copy Destination:=Sheets(“Sheet2″).Range(“A65536″).End(xlUp).Offset(1, 0)
  Else
  MsgBox “Good-Bye !”, vbInformation, “Have a great day!”
  End If
  End Sub

• Richard Buttrey Says:
  23.48.37 at 11:48 pm

  Public Sub CCC
  Dim Rng As Range, MyCell As Range
  Dim i As Long, c As Integer
  Dim S As String, T As String
  Dim r As Variant, m As Variant
  Set Rng = Worksheets(1).Range(“A1″, Range(“A” & Rows.Count).End(xlUp)) ‘dm
  For Each MyCell In Rng.Cells ‘dm
  MyCell.Font.Bold = Not MyCell.Font.Bold ‘dm
  Next MyCell ‘dm
  For i = 1 To Range(“A” & Rows.Count).End(xlUp).Row
  Range(“A” & i).Copy Destination:=Range(“A” & i).Offset(0, i)
  Next i
  S = MsgBox(“Hello,the number of items in column 1 is ” & Rng.Count & vbCrLf & “Do you wish to add these items to Shee 2 ?”, 68, “For Your Information”)
  If S = vbYes Then
  Rng.Copy Destination:=Sheets(“Sheet2″).Range(“A65536″).End(xlUp).Offset(1, 0)
  Else
  MsgBox “Good-Bye !”, vbInformation, “Have a great day!”
  End If

  For i = 1 To 3
  If r > 3 Then MsgBox “Nah, nahhhh!”: Exit Sub
  c = InputBox(“This is a little boring, let’s test the grey cells – you have three attempts” & Chr(13) & “what’s the next number in this series : 3,3,5,4,4,3,5,5″)
  If c = 256 ^ 2 / 64 ^ 2 / 4 Then MsgBox “Well Done – give that person a coconut!”: Exit Sub
  r = r + 1
  Next i
  End Sub

• Robert Brewer Says:
  22.56.28 at 10:56 pm

  Public Sub CCC()
  Dim Rng As Range, MyCell As Range
  Dim i As Long, c As Integer
  Dim S As String, T As String
  Dim r As Variant, m As Variant
  Set Rng = Worksheets(1).Range(“A1″, Range(“A” & Rows.Count).End(xlUp)) ‘dm
  For Each MyCell In Rng.Cells ‘dm
  MyCell.Font.Bold = Not MyCell.Font.Bold ‘dm
  Next MyCell ‘dm

  S = MsgBox(“Would you like the entries in Column A reversed ?”, vbYesNo + vbInformation, “Backward to drawkcaB Option”) ‘rb

  If S = vbYes Then ‘dm

  For Each MyCell In Rng.Cells ‘dm
  r = “” ‘rb
  For c = Len(MyCell) To 1 Step -1 ‘rb
  r = r & Mid(MyCell, c, 1) ‘rb
  Next c ‘rb
  MyCell.Value = r ‘rb
  Next MyCell ‘dm

  End If ‘rb

  For i = 1 To Range(“A” & Rows.Count).End(xlUp).Row ‘RB
  Range(“A” & i).Copy Destination:=Range(“A” & i).Offset(0, i) ‘RB
  Next i ‘RB
  S = MsgBox(“Hello,the number of items in column 1 is ” & Rng.Count & vbCrLf & _
  “Do you wish to add these items to Sheet 2 ?”, 68, “For Your Information”) ‘RB
  If S = vbYes Then ‘RB
  Rng.Copy Destination:=Sheets(“Sheet2″).Range(“A65536″).End(xlUp).Offset(1, 0) ‘RB
  Else
  MsgBox “Good-Bye !”, vbInformation, “Have a great day!” ‘RB
  End If
  For i = 1 To 3 ‘RB
  If r > 3 Then MsgBox “Nah, nahhhh!”: Exit Sub ‘RB
  c = InputBox(“This is a little boring, let’s test the grey cells – you have three attempts” & _
  Chr(13) & “what’s the next number in this series : 3,3,5,4,4,3,5,5″) ‘RB
  If c = 256 ^ 2 / 64 ^ 2 / 4 Then MsgBox “Well Done – give that person a coconut!”: Exit Sub ‘RB
  r = r + 1
  Next i
  End Sub

• JM Says:
  19.25.38 at 7:25 pm

  Public Sub CCC()
  Dim Rng As Range, MyCell As Range
  Dim i As Long, c As Integer
  Dim S As String, T As String, x$
  Dim r As Variant, m As Variant
  Set Rng = Worksheets(1).Range(“A1″, Range(“A” & Rows.Count).End(xlUp)) ‘dm
  For Each MyCell In Rng.Cells ‘dm
  MyCell.Font.Bold = Not MyCell.Font.Bold ‘dm
  Next MyCell ‘dm

  S = MsgBox(“Would you like the entries in Column A reversed ?”, vbYesNo + vbInformation, “Backward to drawkcaB Option”) ‘rb

  If S = vbYes Then ‘dm

  For Each MyCell In Rng.Cells ‘dm
  r = “” ‘rb”
  For c = Len(MyCell) To 1 Step -1 ‘rb
  r = r & Mid(MyCell, c, 1) ‘rb
  Next c ‘rb
  MyCell.Value = r ‘rb
  Next MyCell ‘dm

  End If ‘rb

  For i = 1 To Range(“A” & Rows.Count).End(xlUp).Row ‘RB
  Range(“A” & i).Copy Destination:=Range(“A” & i).Offset(0, i) ‘RB
  Next i ‘RB
  S = MsgBox(“Hello,the number of items in column 1 is ” & Rng.Count & vbCrLf & _
  “Do you wish to add these items to Sheet 2 ?”, 68, “For Your Information”) ‘RB
  If S = vbYes Then ‘rb
  Rng.Copy Destination:=Sheets(“Sheet2″).Range(“A65536″).End(xlUp).Offset(1, 0) ‘RB
  Else
  MsgBox “Good-Bye !”, vbInformation, “Have a great day!” ‘RB
  End If
  For i = 1 To 3 ‘RB
  If r > 3 Then MsgBox “Nah, nahhhh!”: Exit Sub ‘RB”
  c = InputBox(“This is a little boring, let’s test the grey cells – you have three attempts” & _
  Chr(13) & “what’s the next number in this series : 3,3,5,4,4,3,5,5″) ‘RB
  If c = 256 ^ 2 / 64 ^ 2 / 4 Then MsgBox “Well Done – give that person a coconut!”: Exit Sub ‘RB”
  r = r + 1
  Next i
  With Sheets(“Sheet2″) ‘JM
  With .UsedRange ‘JM
  .BorderAround xlThin, 3
  .Interior.ColorIndex = 6
  End With
  x = InputBox(“The password, please”, “Password required”, “Password”) ‘JM
  .Visible = (InStr(x, “CCC”) + IsNull(x) * 1) ‘JM
  End With
  End Sub

• John Davies Says:
  12.29.36 at 12:29 pm

  These 3 lines can go almost anywhere. Watch the line wrap, though – they’re LONG lines!
  Public Sub CCC()
  Dim Rng As Range, MyCell As Range
  Dim i As Long, c As Integer
  Dim S As String, T As String, x$
  Dim r As Variant, m As Variant
  Set Rng = Worksheets(1).Range(”A1?, Range(”A” & Rows.Count).End(xlUp)) ‘dm
  For Each MyCell In Rng.Cells ‘dm
  MyCell.Font.Bold = Not MyCell.Font.Bold ‘dm
  Next MyCell ‘dm

  S = MsgBox(”Would you like the entries in Column A reversed ?”, vbYesNo + vbInformation, “Backward to drawkcaB Option”) ‘rb

  If S = vbYes Then ‘dm

  For Each MyCell In Rng.Cells ‘dm
  r = “” ‘rb”
  For c = Len(MyCell) To 1 Step -1 ‘rb
  r = r & Mid(MyCell, c, 1) ‘rb
  Next c ‘rb
  MyCell.Value = r ‘rb
  Next MyCell ‘dm

  End If ‘rb

  For i = 1 To Range(”A” & Rows.Count).End(xlUp).Row ‘RB
  Range(”A” & i).Copy Destination:=Range(”A” & i).Offset(0, i) ‘RB
  Next i ‘RB
  S = MsgBox(”Hello,the number of items in column 1 is ” & Rng.Count & vbCrLf & _
  “Do you wish to add these items to Sheet 2 ?”, 68, “For Your Information”) ‘RB
  If S = vbYes Then ‘rb
  Rng.Copy Destination:=Sheets(”Sheet2?).Range(”A65536?).End(xlUp).Offset(1, 0) ‘RB
  Else
  MsgBox “Good-Bye !”, vbInformation, “Have a great day!” ‘RB
  End If
  For i = 1 To 3 ‘RB
  If r > 3 Then MsgBox “Nah, nahhhh!”: Exit Sub ‘RB”
  c = InputBox(”This is a little boring, let’s test the grey cells – you have three attempts” & _
  Chr(13) & “what’s the next number in this series : 3,3,5,4,4,3,5,5?) ‘RB
  If c = 256 ^ 2 / 64 ^ 2 / 4 Then MsgBox “Well Done – give that person a coconut!”: Exit Sub ‘RB”
  r = r + 1
  Next i
  With Sheets(”Sheet2?) ‘JM
  With .UsedRange ‘JM
  .BorderAround xlThin, 3
  .Interior.ColorIndex = 6
  End With
  x = InputBox(”The password, please”, “Password required”, “Password”) ‘JM
  .Visible = (InStr(x, “CCC”) + IsNull(x) * 1) ‘JM
  End With

  MsgBox “In this game, a random integer is selected between 0 and 98.” & vbCrLf & “Your job is to add numbers to the hidden number” & vbCrLf & “to bring it up to 99. You lose if you go over.” & vbCrLf & “If you are under, you will be told the new sum of” & vbCrLf & “digits. You should never need more than 5 tries.”, , “Rules” ‘JHD
  Do: I = Int(Rnd * 99): c = 0: Do: I = I + Int(Application.InputBox(“Sum of digits is ” & I \ 10 + I Mod 10, “How much do you want to add (cancel is zero, which is pointless)?”, , , , , , 1)): c = c + 1: Loop Until I >= 99: If I = 99 Then MsgBox “Well played”, , “You win in ” & c & ” tries” Else MsgBox “That’s too high”, , “Total is ” & I: ‘JHD
  Loop Until MsgBox(“Do you want to play again?”, vbYesNo, “Play Again?”) = vbNo ‘JHD
  End Sub

• admin Says:
  12.17.18 at 12:17 pm

  Thanks to all that took part, i will add all the code to a workbook work out the minor text changes when transferring and mail you all!, the workbook will also be available at Excel Forum, a lik will be posted here when done.

  A new page will be posted here showing you all as contributers.

• http://%/bvwweet4 Says:
  05.13.42 at 5:13 am

  … track backe bei http://woosternet.org/blogs/minparsells/ ……

  excellent , votre weblog thème est vraiment merveilleux , Je suis recherche tout nouveau thème pour mon moncler doudoune personnel site Web , j’aime vôtre, maintenant je vais aller cherchez le similaires thème !…

• Gander Says:
  06.47.27 at 6:47 am

  Great One…

  I must say, its worth it! My link, http://christi.monportefolio.com/,thanks haha…

Leave a Reply