Easter in excel

How do we calculate easter in Excel? For a spreadsheet a colleague is making for our vacation planning at work.

There are several ways. The best place I’ve found is here. A site that I’m definitely gonna study closer.

One of the formulas – translated into a danish excel-context:

=AFRUND(DATO(A2;4;1)/7+REST(19*REST(A2;19)-7;30)*14%;0)*7-6

Get the font color of a cell in Excel

People do weird and wonderful things in Excel.

Other people then have to pull out the data from those spreadsheets.

“Other people”  tend to spend a lot of time crying into their coffee.

At the moment, I am trying to pull out data of a spreadsheet, where “something” can have a value of 1, 2 or 3. That is of course marked by an “x” in a cell. I need to convert that x to a number.

That is rather simple. What is not so simple, is that there can be two x’es. One, in black, to denote the current state of affairs. And a second x, in red, to denote what a future, state is wanted to be.

So – I need a way to get the color of an x. VBA can do that:

Function GetColour(ByVal Target As Range) As Single
Application.Volatile
GetColour = Target.Font.Color
End Function

And if I need a logical test:

Function IsBlack(ByVal Target As Range) As Boolean
Application.Volatile
If Target.Font.Color = 0 Then
IsBlack = True
Else
IsBlack = False
End If
End Function

 

Copy rows to another sheet – based on cell-values

And handling images while you’re at it.

Given: We have some data in a sheet – lets call it Source. Based on some values in another sheet – lets call that Condition – we want to copy rows from Source to a third sheet. We’ll call that Target.
To complicate things, we want to copy images as well.

Set some variables to Target, Source and Condition.
Delete the content of the existing target sheet. First alle the images, and then the rest. Note that I’m not deleting everything, just from row 6 and down.
Then for each something (d) in column B (adjust ranges – here I’m only looking at the rows from 2 to 9), check if the relevant row in Source matches, then copy to Target.

There’s a small detail here, I needed to insert an identifier in Target, defined by a value in Condition. Instead of trying to insert in Column B, I’m just searching and replacing a placeholder – “£$”, a string I was pretty certain would not show up anywhere.


Sub CopyYes()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
Dim Condition As Worksheet
Dim k As String
Dim fnd As Variant
Dim rplc As Variant
fnd = "£$"

Set Source = ActiveWorkbook.Worksheets("Ark4") 'Note that ranges in Souce and Condition below should be adjusted. We're not quite there yet.
Set Target = ActiveWorkbook.Worksheets("Ark3")
Set Condition = ActiveWorkbook.Worksheets("Ark1")

' Start by clearing target sheet
' begin with images
Target.Pictures.Delete
' Then we'll delete the rest
'
With Target
.Rows(6 & ":" & .Rows.Count).Delete
End With

j = 7 'This will start copying data to Target sheet at row 1
For Each d In Condition.Range("B2:B9") 'Ark1
k = d.Offset(0, -1)
rplc = k
For Each c In Source.Range("B2:B52") 'Ark2
If d = c Then
Source.Rows(c.row).Copy Target.Rows(j)
j = j + 1
End If
Next c
Target.Cells.Replace what:=fnd, Replacement:=rplc

Next d
'we'll end by hiding some columns
Target.Columns("A:E").Hidden = True
End Sub

Hide rows, based on value of cell – in Excel

So – you want to hide some rows on a worksheet, based on the value in a cell. Or more than one.
Here’s how to do that with VBA
Find the last row of the range that you want to apply the hiding to.
Get a range of rows, in this case starting at A7, and ending at “LastRow”.
For each value in that range, if the value i column A is equal to the value in cell G1 (that is Cells(1,7), And the value three columns over, eg in colum D (that is c.Offset(0,3)), is equal to the value in cell G2 (Cells(2,7), then set the entire row to be hidden, else set it to be shown.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long, c As Range
Application.EnableEvents = False
LastRow = Application.WorksheetFunction.CountA(Range("A7:A100000")) + 6
On Error Resume Next
For Each c In Range("A7:A" & LastRow)
If (c.Value = Cells(1, 7).Value And c.Offset(0, 3).Value = Cells(2, 7).Value) Then
c.EntireRow.Hidden = False
Else
c.EntireRow.Hidden = True
End If
Next
On Error GoTo 0
Application.EnableEvents = True
End Sub