BreadCrumbs: Excel
Excel
From Luke Jackson
(Difference between revisions)
| Revision as of 16:18, 4 September 2012 (edit) Ljackson (Talk | contribs) (→Week Number) ← Previous diff |
Revision as of 03:05, 26 March 2013 (edit) Ljackson (Talk | contribs) (→Color) Next diff → |
||
| Line 258: | Line 258: | ||
| End Function | End Function | ||
| </pre> | </pre> | ||
| + | |||
| + | == Clear Old Pivot Table Labels == | ||
| + | |||
| + | <pre> | ||
| + | Sub DeleteMissingItems2002All() | ||
| + | 'prevents unused items in non-OLAP PivotTables | ||
| + | 'pivot table tutorial by contextures.com | ||
| + | Dim pt As PivotTable | ||
| + | Dim ws As Worksheet | ||
| + | Dim pc As PivotCache | ||
| + | |||
| + | 'change the settings | ||
| + | For Each ws In ActiveWorkbook.Worksheets | ||
| + | For Each pt In ws.PivotTables | ||
| + | pt.PivotCache.MissingItemsLimit = xlMissingItemsNone | ||
| + | Next pt | ||
| + | Next ws | ||
| + | |||
| + | 'refresh all the pivot caches | ||
| + | For Each pc In ActiveWorkbook.PivotCaches | ||
| + | On Error Resume Next | ||
| + | pc.Refresh | ||
| + | Next pc | ||
| + | |||
| + | End Sub | ||
| + | </pre> | ||
| + | |||
| == Color == | == Color == | ||
Revision as of 03:05, 26 March 2013
Windows XP
Excel 2007
Data -> From Other Sources ->
Dynamic Chart Titles From Pivot Table (Date Range)
=IF(DAY(MIN(Summary!$B$6:$B$20))=DAY(MAX(Summary!$B$6:$B$20)),CONCATENATE("CW ",WEEKNUM(MIN(Summary!$B$6:$B$20),1)," - ",TEXT(MIN(Summary!$B$6:$B$20),"mmmm"), ", ",DAY(MIN(Summary!$B$6:$B$20))&IF(OR(DAY(MIN(Summary!$B$6:$B$20))={1,2,3,21,22,23,31}),CHOOSE(1*RIGHT(DAY(MIN(Summary!$B$6:$B$20)),1),"st","nd ","rd"),"th")),CONCATENATE("CW ",WEEKNUM(MIN(Summary!$B$6:$B$20),1)," - ",TEXT(MIN(Summary!$B$6:$B$20),"mmmm"), ", ",DAY(MIN(Summary!$B$6:$B$20))&IF(OR(DAY(MIN(Summary!$B$6:$B$20))={1,2,3,21,22,23,31}),CHOOSE(1*RIGHT(DAY(MIN(Summary!$B$6:$B$20)),1),"st","nd ","rd"),"th")," - ",CONCATENATE("CW ",WEEKNUM(MAX(Summary!$B$6:$B$20),1)," - ",TEXT(MAX(Summary!$B$6:$B$20),"mmmm"), ", ",DAY(MAX(Summary!$B$6:$B$20))&IF(OR(DAY(MAX(Summary!$B$6:$B$20))={1,2,3,21,22,23,31}),CHOOSE(1*RIGHT(DAY(MAX(Summary!$B$6:$B$20)),1),"st","nd ","rd"),"th"))))
Week Number
=CONCATENATE("Cal Week: ", (1+INT((#REF!-(DATE(YEAR(#REF!),1,2)-WEEKDAY(DATE(YEAR(#REF!),1,0))))/7)))
=WEEKNUM(TEXT(E2, "mmmm dd, yyyy"), 2)
Count Cells when not blank
=COUNTIF(D2:G2,"<>"&"")
Concatenate Vlookup Values When Source is not blank
=CONCATENATE(IF(D17 <> "",(VLOOKUP(D17,Printtypes!$A$1:$B$19, 2,FALSE)),""),IF(E17 <> "",(", " & VLOOKUP(E17,Printtypes!$A$1:$B$19, 2,FALSE)),""),IF(F17 <> "",(", " & VLOOKUP(F17,Printtypes!$A$1:$B$19, 2,FALSE)),""),IF(G17 <> "",(", " & VLOOKUP(G17,Printtypes!$A$1:$B$19, 2,FALSE)),""))
CountIf with Subtotal (Respects Hidden/Filtered Cells
=SUMPRODUCT(SUBTOTAL(3,OFFSET(B1:B51,ROW(B1:B51)-ROW(B1),0,1)),--(B1:B51="Inactive"))
Count Unique Names / Numbers
The entire formula is as follows (replace C3:C25 with the range of data you want the formula to check)
=SUM(IF(FREQUENCY(IF(LEN(C3:C25)>0,MATCH(C3:C25,C3:C25,0),""), IF(LEN(C3:C25)>0,MATCH(C3:C25,C3:C25,0),""))>0,1))
If you just want to count unique numbers, and not text, use the following formula instead:
=SUM(IF(FREQUENCY(C3:C25, C3:C25)>0,1))
Split string by occurrence of character
Return the portion of string from the second occurrence of character:
=RIGHT($E2;LEN($E2) - FIND("-";$E2;FIND("-";$E2)+1))
Return the portion of string until the first occurrence of character:
=LEFT($E2;FIND("-";$E2)-1)
Conditional Formating "At Change In Value"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim C As Variant
Dim Clast As Variant
Dim CI As Integer
Dim ColS As Variant
Dim ColE As Variant
Dim FirstRow As Long
Dim LastRow As Long
Dim Rng As Range
Dim Wks As Worksheet
Dim Color As Boolean
Dim Total As Long
If Target.Row > 0 Then
ColS = "A"
ColE = "L"
FirstRow = 2 'Assumes header row is row 1
Set Wks = Worksheets("Scoreboard")
'LastRow = Wks.Cells(Rows.Count, ColS).End(xlUp).Row
LastRow = Target.Row
LastRow = IIf(LastRow < FirstRow, FirstRow, LastRow)
Set Rng = Wks.Range(Cells(FirstRow, ColS), Cells(LastRow, ColS))
For Each C In Rng
If IsDate(C) Then
If Clast = "" Then
CI = 50
Clast = C
'MsgBox "Start " & C & " - " & Clast
ElseIf C <> Clast And Color = False Then
CI = xlColorIndexNone
Color = True
'MsgBox "CF CNE " & C & "<>" & Clast
Clast = C
ElseIf C <> Clast And Color = True Then
CI = 50
Color = False
'MsgBox "CT CNE " & C & "<>" & Clast
Clast = C
ElseIf C = Clast And Color = False Then
CI = 50
'MsgBox "CF CE " & C & "=" & Clast
Clast = C
ElseIf C = Clast And Color = True Then
CI = xlColorIndexNone
'MsgBox "CT CE " & C & "=" & Clast
Clast = C
Else
CI = xlColorIndexNone
MsgBox "Else " & C
End If
If CI > 0 Then
With Range(Cells(C.Row, ColS), Cells(C.Row, ColE)).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Else
With Range(Cells(C.Row, ColS), Cells(C.Row, ColE)).Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End If
Total = Total + 1
Next C
'MsgBox Total
End If
End Sub
Function
=IF(INDIRECT(ADDRESS(ROW(),1,3))<>INDIRECT(ADDRESS((ROW()-1),1,3)),1,0)
Date Filters Not Available for Pivot Table / Chart
Date Filters are not supported in Excel 2003 compatibility mode.
Re-save document in Excel 2007 format and the options will no longer be greyed out.
Dynamic Graph/Chart Title
="Operator Summary - " & TEXT(MIN(Summary!$B$6:$B$20),"ddd, mmm dd, yyyy") & " to " & TEXT(MAX(Summary!$B$6:$B$20),"ddd, mmm dd, yyyy")
Mac OS X
File Not Found
When starting Microsoft Excel 2004 for Mac OS X you may get the error "File Not Found".
First place to check is the Excel Startup folder:
ljackson 14:46:50 ~/Library/Preferences> cd /Applications/Microsoft\ Office\ 2004/Office/Startup/ ljackson 14:47:33 /Applications/Microsoft Office 2004/Office/Startup> ll drwxrwxr-x 4 ljackson admin 136B May 3 14:39 Excel drwxrwxr-x 2 ljackson admin 68B Apr 8 2004 PowerPoint drwxrwxr-x 2 ljackson admin 68B Apr 8 2004 Word ljackson 14:47:33 /Applications/Microsoft Office 2004/Office/Startup> cd Excel/ ljackson 14:47:37 /Applications/Microsoft Office 2004/Office/Startup/Excel> ll total 96 -rw-r--r-- 1 ljackson admin 25K May 3 14:15 8DAE9700 -rw-r--r-- 1 ljackson admin 16K May 3 14:39 Personal Macro Workbook
In my case the alphanumerical file was generated when Excel crashed. So I will delete it:
ljackson 14:47:38 /Applications/Microsoft Office 2004/Office/Startup/Excel> rm -f 8DAE9700 ljackson 14:47:53 /Applications/Microsoft Office 2004/Office/Startup/Excel> ll total 40 -rw-r--r-- 1 ljackson admin 16K May 3 14:39 Personal Macro Workbook
Now I don't get the anoying error "File Not Found" every time I launch Excel.
VBA Macros
Sub RangeDateFix()
Dim ndate As String
'ActiveCell.CurrentRegion.Cells.Select
For Each c In ActiveWindow.RangeSelection.Cells
ndate = USdateEU(c.Value)
c.Value = ndate
Next
End Sub
Public Function USdateEU(ByVal tdate As String)
Dim txt As String, ftxt As String, x As Variant, i As Long
txt = tdate
x = Split(txt, "/")
'For i = 0 To UBound(x)
'MsgBox x(i)
'Next i
ftxt = x(1) & "/" & x(0) & "/" & x(2)
USdateEU = ftxt
'MsgBox ftxt
End Function
Public Function Split(ByVal sInput As String, _
Optional ByVal sDelimiter As String, _
Optional ByVal nLimit As Long = -1, _
Optional ByVal bCompare As Integer = vbBinaryCompare _
) As Variant
Dim nCount As Long
Dim nPos As Long
Dim nDelimiterLength As Long
Dim nStart As Long
Dim sOutput() As String
If nLimit = 0 Then
Split = Array()
Else
nDelimiterLength = Len(sDelimiter)
If nDelimiterLength = 0 Then
Split = Array(sInput)
Else
nStart = 1
nPos = InStr(nStart, sInput, sDelimiter, bCompare)
Do While nPos
ReDim Preserve sOutput(0 To nCount) As String
If nCount + 1 = nLimit Then
sOutput(nCount) = Mid(sInput, nStart)
Exit Do
Else
sOutput(nCount) = Mid(sInput, nStart, nPos - nStart)
nStart = nPos + nDelimiterLength
End If
nCount = nCount + 1
nPos = InStr(nStart, sInput, sDelimiter, bCompare)
Loop
ReDim Preserve sOutput(0 To nCount) As String
sOutput(nCount) = Mid(sInput, nStart)
Split = sOutput
End If
End If
End Function
Clear Old Pivot Table Labels
Sub DeleteMissingItems2002All()
'prevents unused items in non-OLAP PivotTables
'pivot table tutorial by contextures.com
Dim pt As PivotTable
Dim ws As Worksheet
Dim pc As PivotCache
'change the settings
For Each ws In ActiveWorkbook.Worksheets
For Each pt In ws.PivotTables
pt.PivotCache.MissingItemsLimit = xlMissingItemsNone
Next pt
Next ws
'refresh all the pivot caches
For Each pc In ActiveWorkbook.PivotCaches
On Error Resume Next
pc.Refresh
Next pc
End Sub
Color
Function HEXCOL2RGB(ByVal HexColor As String) As String
'The input at this point could be HexColor = "#00FF1F"
Dim Red As String
Dim Green As String
Dim Blue As String
Dim Color As String
Color = Replace(HexColor, "#", "")
'Here HexColor = "00FF1F"
Red = Val("&H" & Mid(Color, 1, 2))
'The red value is now the long version of "00"
Green = Val("&H" & Mid(Color, 3, 2))
'The red value is now the long version of "FF"
Blue = Val("&H" & Mid(Color, 5, 2))
'The red value is now the long version of "1F"
'HEXCOL2RGB = RGB(Red, Green, Blue)
HEXCOL2RGB = Red & "," & Green & "," & Blue
'The output is an RGB value
End Function
Sub CvrtHex()
Dim Cell As Range
If TypeName(Selection) <> "Range" Then Exit Sub
For Each Cell In Selection
If Cell.Value < 0 Then
'Debug.Print ""
Else
Debug.Print HEXCOL2RGB(Cell.Value)
Cell.Next.Value = HEXCOL2RGB(Cell.Value)
End If
Next Cell
End Sub
Sub CvrtHex2()
Dim Cell As Range
Dim clrs As Variant
If TypeName(Selection) <> "Range" Then Exit Sub
For Each Cell In Selection
If Cell.Value < 0 Then
'Debug.Print ""
Else
clrs = Split(Cell.Value, ",")
Debug.Print clrs(0) & " " & clrs(1) & " " & clrs(2)
Cell.Next.Interior.Color = RGB(clrs(0), clrs(1), clrs(2))
Cell.Next.Value = "R" & clrs(0) & " G" & clrs(1) & " B" & clrs(2)
If clrs(0) < 200 And clrs(1) < 200 And clrs(2) < 200 Then
Cell.Next.Font.Color = RGB(255, 255, 255)
Debug.Print "White"
Else
Cell.Next.Font.Color = RGB(0, 0, 0)
End If
End If
Next Cell
End Sub