August 28, 2005

Select Cells Like

Find as in Find and Replace (Ctrl + F) is a great search feature in Excel. Here's a picture of being used to find cells that contain "at".



But finding and selecting are 2 different tasks. In order to select all cells listed, I can click the top line then scroll down and click the bottom line while pushing Shift or try pushing Ctrl + A but it seems a little awkward if you are in a hurry. (Perhaps I complain too much? :-) )

Anyway, I was playing with Like today and wrote some simple code to both find and select at the same time. Good practice for me in any case.

Enter your search term... (Use ActiveSheet.UsedRange instead of Selection if you prefer to select the entire sheet)



Sub SelectCellsLike()
    On Error Resume Next
    Dim myString As String, c As Range, rFind As Range
    myString = InputBox("Enter your search string.", "Select Cells Like")
    For Each c In Selection ' use ActiveSheet.UsedRange to search entire sheet
        If c.Value Like "*" & myString & "*" Then
            If rFind Is Nothing Then
                Set rFind = c
            Else
                Set rFind = Union(rFind, c)
            End If
        End If
    Next
    rFind.Select
End Sub

Push Ok and they are selected.



By the way, here's something that might be useful for later versions of Excel. If you double click the title bar of dialog boxes such as Find, Open or Save As, they will maximize which makes things a lot easier to see. Double click the title bar again and it minimizes (returns to it's normal size)  

Posted by andrewe at 18:58

August 25, 2005

Splashscreen

Sooner or later, everyone wants to try making a splashscreen. Most that I seen so far seem be made with a userform, but I wanted to try making a very simple one using AutoShapes.



Actually, this is a picture of two Autoshapes that have been grouped together. The Fill effects are Papyrus and Medium Wood, obtained from doube clicking the shapes while they are still separate and selecting Format AutoShape, Color and Lines, Fill Color, Fill Effects, Texture.

Here's the code I used.

Sub SplashscreenShape()
    Dim Ctr As Long
    ThisWorkbook.Sheets("Sheet3").Activate
    Range("A1:R41").Select
    ActiveWindow.Zoom = True
    Do While Ctr < 5
        ActiveSheet.Shapes("Message").Select
        Select Case Ctr
        Case 0
            Selection.Characters.Text = "CHANGE" & Chr(10) & "IT" & Chr(10) & "A" & Chr(10) & "BIT"
        Case 1
        Selection.Characters.Text = "WRITE" & Chr(10) & "ANYTHING" & Chr(10) & "YOU" & Chr(10) & "LIKE"
        Case 2
            Selection.Characters.Text = "DO" & Chr(10) & "IT" & Chr(10) & "FOR" & Chr(10) & "FUN"
        Case 3
            Selection.Characters.Text = "THIS" & Chr(10) & "IS" & Chr(10) & "THE" & Chr(10) & "END"
        End Select
        Ctr = Ctr + 1
        Application.Wait Now + TimeSerial(0, 0, 2)
        Loop
        Application.ScreenUpdating = False
        ActiveSheet.Shapes("Message").Select
        Selection.Characters.Text = "PUT" & Chr(10) & "SOME" & Chr(10) & "TEXT" & Chr(10) & "HERE"
        Range("IV65536").Select
        ThisWorkbook.Sheets("Sheet1").Select
    Application.ScreenUpdating = True
End Sub

Sub Auto_Open()
    SplashscreenShape
End Sub

Sub Auto_Close()
    ThisWorkbook.Close SaveChanges:=False
End Sub

Note that I've used "ActiveWindow.Zoom". This is so the range A1:R41 is zoomed in or zoomed out automatically which helps the dimensions of the AutoShape to retain their proportions on different size screens.

Here's a sample workbook to download. Nothing brilliant, just something for my own amusement ;-)  
Posted by andrewe at 23:34

August 22, 2005

New Calendar Formula

After some "prompting" on my Japanese blog, I spent a bit of time cleaning up my old calendar formula. Well, it was just meant to be a one-formula version of something I did a long time ago, being a lazy person I had pretty well left it as is...

Anyway, while I was at it, I wondered if I could make it an array formula like J-Walk's at the top of this post. A couple of things to remember about array formulas,

1. Select the entire range in which the formula is to be entered, then push Ctrl, Shift and Enter at the same time instead of just Enter. A set of curly brackets will appear at either end automatically, don't try to add them yourself. in the case of a calendar formula you will need 7 columns x 6 rows.

2. Commas and semi-colons can be used for different ways. For example, here's a picture of commas used in a vertical array.



Now here's the same array with semicolons. See the difference?



The opposite is true for horizontal arrays. We can use a combiantion of the two to make calendar array formulas like this one for the current month.

=IF({1;2;3;4;5;6}*7+{1,2,3,4,5,6,7}-WEEKDAY(DATE(YEAR(NOW()),MONTH(NOW()),1))-6<1,"",IF({1;2;3;4;5;6}*7+{1,2,3,4,5,6,7}-WEEKDAY(DATE(YEAR(NOW()),MONTH(NOW()),1))-6>DAY(DATE(YEAR(NOW()),MONTH(NOW())+1,0)),"",{1;2;3;4;5;6}*7+{1,2,3,4,5,6,7}-WEEKDAY(DATE(YEAR(NOW()),MONTH(NOW()),1))-6))

Which can be shortened to something like this.

=IF({1;2;3;4;5;6}*7+{1,2,3,4,5,6,7}-WEEKDAY(NOW()-DAY(NOW())+1)-6<1,"",IF({1;2;3;4;5;6}*7+{1,2,3,4,5,6,7}-WEEKDAY(NOW()-DAY(NOW())+1)-6>DAY(DATE(YEAR(NOW()),MONTH(NOW())+1,0)),"",{1;2;3;4;5;6}*7+{1,2,3,4,5,6,7}-WEEKDAY(NOW()-DAY(NOW())+1)-6))

Yes, it's shorter, but it can't be adjusted for different years or months like the one above. (You can adjust the first formula by replacing YEAR(NOW()) and MONTH(NOW()) with numbers as in 2005 for the year and 8 for August)

Here's another version by the person who did the prompting who goes by the name of Kir San.

=IF(({1,2,3,4,5,6,7}+{0;1;2;3;4;5}*7>=WEEKDAY(DATE(YEAR(NOW()),MONTH(NOW()),1))+DAY(DATE(YEAR(NOW()),MONTH(NOW())+1,0)))+({1,2,3,4,5,6,7}+{0;1;2;3;4;5}*7<WEEKDAY(DATE(YEAR(NOW()),MONTH(NOW()),1))),"",{1,2,3,4,5,6,7}+{0;1;2;3;4;5}*7-WEEKDAY(DATE(YEAR(NOW()),MONTH(NOW()),1))+1)

I like this formula because it uses just one IF. (I wanted to use AND or OR, but they don't seem to work in this case so I took the easy way out :-))

Anyway, true credit goes to the orginator I think. Tinkering with something already invented is okay, but if I had never seen J-Walk's formula, I never would have tried using an array in the first place. Kir San gets my thanks for some rather nifty formulas, I would have been content to wallow in the mire if he didn't give me a push and a shove.

PS. If you want weeks to start from Mondays, give this a go.

=IF({1;2;3;4;5;6}*7+{1,2,3,4,5,6,7}-WEEKDAY(DATE(YEAR(NOW()),MONTH(NOW()),1),2)-6<1,"",IF({1;2;3;4;5;6}*7+{1,2,3,4,5,6,7}-WEEKDAY(DATE(YEAR(NOW()),MONTH(NOW()),1),2)-6>DAY(DATE(YEAR(NOW()),MONTH(NOW())+1,0)),"",{1;2;3;4;5;6}*7+{1,2,3,4,5,6,7}-WEEKDAY(DATE(YEAR(NOW()),MONTH(NOW()),1),2)-6))

Happy head hurting!  
Posted by andrewe at 19:51

August 07, 2005

Find And Replace In Conditional Formatting

When working with Conditional Formatting, I often find myself wanting to replace just part of a format but this can be quite difficult and/or time consuming depending on how everything is set up. (I'm not sure if this already exists within Excel's built-in features or whether somebody else has devised a better way. Whatever. This is something I made last week to make life more bearable)

The code below is limited to working with "Formula Is" type formatting and cell background colors and font colors. Note: All other formats such as borders (lines) will be lost forever. If you want to retain them, feel free to change the code as you like. You might want to save and check it works properly before you use it on a large scale.

Sub FindAndReplaceConditionalFormat()
    On Error Resume Next
    Dim c As Range, myRange As Range
    Dim fndValue As String, rplValue As String
    Dim frmtString1 As String, frmtString2 As String, frmtString3 As String
    Dim frmtColor1 As Long, frmtFont1 As Long
    Dim frmtColor2 As Long, frmtFont2 As Long
    Dim frmtColor3 As Long, frmtFont3 As Long
    fndValue = InputBox("Please enter the find value.", "Find And Replace")
    If fndValue = "" Then Exit Sub
    rplValue = InputBox("Please enter the replace value.", "Find And Replace")
    If rplValue = "" Then Exit Sub
    Set myRange = Selection
    Application.ScreenUpdating = False
    For Each c In myRange.Cells
        frmtString1 = Application.Substitute(c.FormatConditions(1).Formula1, fndValue, rplValue)
        frmtColor1 = c.FormatConditions(1).Interior.ColorIndex
        frmtFont1 = c.FormatConditions(1).Font.ColorIndex
        frmtString2 = Application.Substitute(c.FormatConditions(2).Formula1, fndValue, rplValue)
        frmtColor2 = c.FormatConditions(2).Interior.ColorIndex
        frmtFont2 = c.FormatConditions(2).Font.ColorIndex
        frmtString3 = Application.Substitute(c.FormatConditions(3).Formula1, fndValue, rplValue)
        frmtColor3 = c.FormatConditions(3).Interior.ColorIndex
        frmtFont3 = c.FormatConditions(3).Font.ColorIndex
        c.FormatConditions.Delete
        c.FormatConditions.Add Type:=xlExpression, Formula1:=frmtString1
        c.FormatConditions(1).Interior.ColorIndex = frmtColor1
        c.FormatConditions(1).Font.ColorIndex = frmtFont1
        c.FormatConditions.Add Type:=xlExpression, Formula1:=frmtString2
        c.FormatConditions(2).Interior.ColorIndex = frmtColor2
        c.FormatConditions(2).Font.ColorIndex = frmtFont2
        c.FormatConditions.Add Type:=xlExpression, Formula1:=frmtString3
        c.FormatConditions(3).Interior.ColorIndex = frmtColor3
        c.FormatConditions(3).Font.ColorIndex = frmtFont3
    Next
    myRange.Select
    Application.ScreenUpdating = True
End Sub

Summer holidays are approaching so I might take a couple of weeks off. I'll still be hanging around as I usually do though :-)  
Posted by andrewe at 16:39

August 01, 2005

ISO Calendar for Excel

I use the ISO Calendar at work a lot. It's very useful in a number of fields such as Manufacturing, Logistics, Shipping etc. To get the week number of a date, you can use this handy formula by Evert van den Heuvel. (Date is in Cell A1)

=1+INT((A1-DATE(YEAR(A1+4-WEEKDAY(A1+6)),1,5)+WEEKDAY(DATE(YEAR(A1+4-WEEKDAY(A1+6)),1,3)))/7)

I was bored yesterday so I decided to take a closer look at how ISO Calendars work. (In between bouts of surfing the web and sleeping)

This formula will calculate the ISO New Year where the date in Cell A1 is January 1 of that year.

=IF(WEEKDAY(A1)>5,A1-(WEEKDAY(A1)-2)+7,A1-(WEEKDAY(A1)-2))

or you can use this simplified version.

=A1-(WEEKDAY(A1)-2)+(INT(WEEKDAY(A1)/6)*7)

This formula will calculate how many weeks are in the year (again Cell A1 is Janaury 1 of that year) Most years have 52 weeks, but every now and then there is a leap week which makes 53 weeks in total.

=--OR(WEEKDAY(A1)=5,WEEKDAY(DATE(YEAR(A1),MONTH(A1)+11,DAY(A1)+30))=5)+52

I also made a ISO Calendar based on my previous formula. Enter a year and the calendar weeks and dates will adjust automatically. (Default year if left blank is the current year) It also includes the day numbers underneath the dates.



Here's the download link. Hope it's useful ;-)  
Posted by andrewe at 21:40