excel.txt - my crazy notes for excel --- name a cell put "=GET.CELL(48,A1)" on bottom. Do a conditional formatting with that name used. Use for finding formulas with conditional formatting =GET.CELL(48,INDIRECT("rc",FALSE)) 'find cells that contain formulas =MOD(ROW(),2)=0 'Conditional format function for everyother cell color = ' Rows("20:30").RowHeight = 15.75 'fix row width to 15.75 ' Rows("30:30").EntireRow.AutoFit 'fix row width to autofit --- Sub ToggleMenuControls() Dim m As CommandBarControl, mi As CommandBarControl Set m = CommandBars.FindControl(ID:=30002) ' File Menu If m Is Nothing Then Exit Sub For Each mi In m.Controls If mi.ID = 18 Then mi.Enabled = Not mi.Enabled ' toggles the state for the Print menu Next mi Set mi = Nothing Set m = Nothing End Sub --- Sub PrintTables() ' ' PrintTables Macro ' Macro recorded 7/22/2002 by GerryS ' ' Keyboard Shortcut: Ctrl+p ' With ActiveSheet.PageSetup .PrintTitleRows = "$2:$9" .PrintTitleColumns = "" End With ActiveSheet.PageSetup.PrintArea = "WithDebt" With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "Page &P" & Chr(10) & "&D" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0) .RightMargin = Application.InchesToPoints(0) .TopMargin = Application.InchesToPoints(0.5) .BottomMargin = Application.InchesToPoints(0) .HeaderMargin = Application.InchesToPoints(0) .FooterMargin = Application.InchesToPoints(0) .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .PrintQuality = 600 .CenterHorizontally = False .CenterVertically = False .Orientation = xlLandscape .Draft = False .PaperSize = xlPaperLetter .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = True .Zoom = 57 End With ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True With ActiveSheet.PageSetup .PrintTitleRows = "$2:$9" .PrintTitleColumns = "" End With ActiveSheet.PageSetup.PrintArea = "NoDebt" With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "Page &P" & Chr(10) & "&D" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0) .RightMargin = Application.InchesToPoints(0) .TopMargin = Application.InchesToPoints(0.5) .BottomMargin = Application.InchesToPoints(0) .HeaderMargin = Application.InchesToPoints(0) .FooterMargin = Application.InchesToPoints(0) .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .PrintQuality = 600 .CenterHorizontally = False .CenterVertically = False .Orientation = xlLandscape .Draft = False .PaperSize = xlPaperLetter .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = True .Zoom = 57 End With ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True With ActiveSheet.PageSetup .PrintTitleRows = "$2:$9" .PrintTitleColumns = "" End With ActiveSheet.PageSetup.PrintArea = "SummaryOfCosts" With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "Page &P" & Chr(10) & "&D" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0) .RightMargin = Application.InchesToPoints(0) .TopMargin = Application.InchesToPoints(0.5) .BottomMargin = Application.InchesToPoints(0) .HeaderMargin = Application.InchesToPoints(0) .FooterMargin = Application.InchesToPoints(0) .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .PrintQuality = 600 .CenterHorizontally = False .CenterVertically = False .Orientation = xlLandscape .Draft = False .PaperSize = xlPaperLetter .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = True .Zoom = 57 End With ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End Sub --- Sub Color_Checker() Dim Start_Cell, Finish_Row, Finish_Col Start_Cell = "$AI$1" Finish_Col = "84" Finish_Row = "500" Start_Cell_Col = "$AI" 'MsgBox (Finish_Col) 'MsgBox (Finish_Row) 'MsgBox (ActiveCell.Col) 'MsgBox (ActiveCell.Row) Range(Start_Cell).Select Do Do If Hex(ActiveCell.Font.Color) = "80" Then ActiveCell.Interior.Color = vbBlack Else End If ActiveCell.Offset(0, 1).Select Loop While ActiveCell.Column <> Finish_Col ActiveCell.Offset(1, 0).Select 'move down one Cells(ActiveCell.Row, Start_Cell_Col).Select 'go back to beginning of row Loop While ActiveCell.Row <> Finish_Row 'MsgBox (Hex(ActiveCell.Interior.Color)) 'CCFFCC light color End Sub --- Sub RP_Info_Grabber() ' RP_Info_Grabber Macro ' Macro recorded 4/1/2004 by donnyy ' This Macro works like a look-up function and puts data horizontal ' ' Couple Reminders About this Macro ' Data must be copied from MasterAccessConv.xls (Data From Access) file ' Make sure that the data copied are "Blanks" for months (Blanks are Year Totals) ' Paste copied data to "ResourceSorting" Sheet *** ' The Macro will grad the data from this Sheet ' The Macro looks for color ' The code below, is set to look for "Brown" color *** ' The easiest way (I thought) for Excel to distinguish colors is by hexadecimal ' 6 Digits (0-F) that resembles the color scheme RGB () ' Errors in the Code ' If there are any Errors, I'd tell you to blame it on Gerry ' But really, you should blame it on the programmer -> me Dim Start_Cell, Finish_Row, Finish_Col Dim Sheet_Name, Row_Year, Col_Station, Col_Subject, Sheet_Resource, Col_Year, Col_Month, Col_aName, Month_Num, Do_Not_Exceed Dim Resource_Start_Cell, Counter, Check, Check_Again, Row_Coordinate, Col_Coordinate, Station, Subject, Origin, Temp Dim System_Col_Year, System_Col_Month, System_Do_Not_Exceed, System_Start_Cell ' Initial values go in this section 'Font Color Searching Start_Cell = "$AI$1" '<---------- Enter the Name of Start Cell (Usually "$A$1") Finish_Col = "84" '<---------- Enter Finish_Row = "500" '<---------- Enter Start_Cell_Col = "$AI" '<---------- Enter 'Front Page Attributes Sheet_Name = "RP BASE" '<---------- Enter the Name of Sheet Row_Year = "$9" '<---------- Enter the Row Value That the Years are Displayed Col_Station = "$AJ" '<---------- Enter the Col Value That the Stations are Displayed Col_Subject = "$AK" '<---------- Enter the Col Value That the Subjects are Displayed 'Resource Page Attributes Sheet_Resource = "ResourcesSorting" '<---------- Enter the Name of Sheet Where the Data Comes From Col_Year = "$B" '<---------- Enter the Col Value That the Years are Displayed Col_Month = "$C" '<---------- Enter the Col Value That the Months are Displayed Col_aName = "$D" '<---------- Enter the Col Value That the aNames are Displayed Month_Num = "" '<---------- Enter the Month to Find (1-12, "" Being The Total for the Year) Do_Not_Exceed = 500 '<---------- Enter the Number Not to Exceed, Otherwise it would be Infinite Counter = 0 'Always Start Counter at Zero Resource_Start_Cell = "$A1" 'System Attributes of the Resource Page System_Col_Year = "$T" System_Col_Month = "$U" System_Do_Not_Exceed = 25 System_Start_Cell = "$Q1" ' Code Starts Here Application.ScreenUpdating = False 'Turn Screen Updating Off for Faster Results Range(Start_Cell).Select 'Start at "A1" Do Do If Hex(ActiveCell.Font.Color) = "80" Then 'If Font Color is Brown 'Do Resource Lookup Check = False: Check_Again = False 'Initialize Values Origin = ActiveCell.Address Counter = 0 Row_Coordinate = Cells(ActiveCell.Row, Col_Subject).Value Col_Coordinate = Cells(Row_Year, ActiveCell.Column).Value Station = Cells(ActiveCell.Row, Col_Station).Value ' Starts Lookup Here If (Row_Coordinate <> "") And (Col_Coordinate <> "") And (Station <> "") Then 'If Cell Contains All Coordinates Sheets(Sheet_Resource).Select 'Select ResourcesSorting Sheet Range(Resource_Start_Cell).Select 'Start at A1 of ResourcesSorting Sheet Do If (ActiveCell.Value = Row_Coordinate) Then Check = True Do If (Cells(ActiveCell.Row, Col_Year) = Col_Coordinate) And (Cells(ActiveCell.Row, Col_aName) = Station) And (Cells(ActiveCell.Row, Col_Month) = Month_Num) Then Check_Again = True Temp = ActiveCell.Value Sheets(Sheet_Name).Select Range(Origin).Value = Temp 'MsgBox (ActiveCell.Value) Else If (Counter < Do_Not_Exceed) Then Counter = Counter + 1 ActiveCell.Offset(1, 0).Select 'Move Down Else Check_Again = True 'Get Out of the Loop Sheets(Sheet_Name).Select 'Select Initial Sheet Range(Origin).Value = "0.0" 'Enter 0.0 Because Macro Found Nothing End If End If Loop While Check_Again = False Else ActiveCell.Offset(0, 1).Select End If Loop While Check = False Else MsgBox ("Cannot Compute, One Cell Reference Doesn't Contain Data") End If Else If Hex(ActiveCell.Font.Color) = "993333" Then 'If Font Color is Brown 'Do System Lookup Check = False: Check_Again = False 'Initialize Values Origin = ActiveCell.Address Counter = 0 Row_Coordinate = Cells(ActiveCell.Row, Col_Subject).Value Col_Coordinate = Cells(Row_Year, ActiveCell.Column).Value 'Station = Cells(ActiveCell.Row, Col_Station).Value 'Starts Lookup Here If (Row_Coordinate <> "") And (Col_Coordinate <> "") Then 'If Cell Contains All Coordinates Sheets(Sheet_Resource).Select 'Select ResourcesSorting Sheet Range(System_Start_Cell).Select 'Start at A1 of ResourcesSorting Sheet Do If (ActiveCell.Value = Row_Coordinate) Then Check = True Do If (Cells(ActiveCell.Row, System_Col_Year) = Col_Coordinate) And (Cells(ActiveCell.Row, System_Col_Month) = Month_Num) Then Check_Again = True Temp = ActiveCell.Value Sheets(Sheet_Name).Select Range(Origin).Value = Temp 'MsgBox (ActiveCell.Value) Else If (Counter < System_Do_Not_Exceed) Then Counter = Counter + 1 ActiveCell.Offset(1, 0).Select 'Move Down Else Check_Again = True 'Get Out of the Loop Sheets(Sheet_Name).Select 'Select Initial Sheet Range(Origin).Value = "0.0" 'Enter 0.0 Because Macro Found Nothing End If End If Loop While Check_Again = False Else ActiveCell.Offset(0, 1).Select End If Loop While Check = False Else MsgBox ("Cannot Compute, One Cell Reference Doesn't Contain Data") End If Else End If End If ActiveCell.Offset(0, 1).Select Loop While ActiveCell.Column <> Finish_Col ActiveCell.Offset(1, 0).Select 'move down one Cells(ActiveCell.Row, Start_Cell_Col).Select 'go back to beginning of row Loop While ActiveCell.Row <> Finish_Row Application.ScreenUpdating = True 'Turn Screen Updating Back On Range(Start_Cell).Select MsgBox ("Macro Complete") End Sub --- Public Function FileList(Mask As String) As String() Dim sWkg As String Dim sAns() As String Dim lCtr As Long ReDim sAns(0) As String sWkg = Dir(Mask, vbNormal) Do While Len(sWkg) If sAns(0) = "" Then sAns(0) = sWkg Else lCtr = UBound(sAns) + 1 ReDim Preserve sAns(lCtr) As String sAns(lCtr) = sWkg End If sWkg = Dir Loop FileList = sAns End Function --- Private Sub CommandButton1_Click() Range("g40").Select ActiveCell.FormulaR1C1 = TextBox1.Value End Sub // button & text --- Private Sub TextBox1_Change() End Sub --- Private Sub Worksheet_Change(ByVal Target As Excel.Range) 'This procedure runs whenever a cell is changed by the user (not by recalculation) If Target.Address() = "$G$1" Then 'Check the cell the user has changed Range("$MM$1").Select 'move the cursor End If End Sub --- Sub Make Function() ' ' This spits the bottom function in a desired cell selected ' ActiveCell.FormulaR1C1 = "=R[-1]C + R[-2]C + R[-2]C" // "= some function" Range("D154").Select End Sub --- excel reference R[]C[] vb activecell.formulaR1C1= // key words for google search // calculates 5 year inflation but contains no references ActiveCell.FormulaR1C1 = "=R[-1]C+((R[-2]C-R[-3]C+R[-3]C-R[-4]C+R[-4]C-R[-5]C+R[-5]C-R[-6]C+R[-6]C-R[-7]C)/(count(R[-7]C:R[-2]C)-1))" ActiveCell.Offset(0, 1).Select --- =CELL("filename") // returns C:\Work Files\[Matrix Conversion Sheet.xls]Sheet2 =MID(CELL("filename"),FIND("]",CELL("filename"))+1,255) // returns sheet name =MID(CELL("filename"),1,FIND("[",CELL("filename"))-1) // returns full path =MID(CELL("filename"),1,FIND("[",CELL("filename"))+1, FIND("]",(CELL("filename"))-FIND("[",CELL("filename"))-1) // returns worksheet name =find(" ",text,start) // find location of something =DAY(DATE(YEAR(A1),MONTH(A1)+1,1)-1) // days in mont =SUMIF(A2:A10,"Jan",C2:C10) // Count of Sales, where Month="Jan" =COUNTIF(A2:A10,"Jan") // This is a straightforward use of the COUNTIF function (single criterion): =SUMIF(A2:A10,"<>Jan",C2:C10) // Sum of Sales, where Month<>"Jan" =SUMIF(A2:A10,"Jan",C2:C10)+SUMIF(A2:A10,"Feb",C2:C10) // Sum of Sales where Month="Jan" or "Feb" =SUM((A2:A10="Jan")*(B2:B10="North")*C2:C10) // Sum of Sales where Month="Jan" AND Region="North" =SUM((A2:A10="Jan")*(B2:B10<>"North")*C2:C10) // Sum of Sales where Month="Jan" AND Region<>"North" (requires array) =SUM((A2:A10="Jan")*(B2:B10="North")) // Count of Sales where Month="Jan" AND Region="North" =SUM((A2:A10="Jan")*(C2:C10>=200)*(C2:C10)) // Sum of Sales where Month="Jan" AND Sales>= 200 =SUM((C2:C10>=300)*(C2:C10<=400)*(C2:C10)) // Sum of Sales between 300 and 400 =SUM((C2:C10>=300)*(C2:C10<=400)) // Count of Sales between 300 and 400 --- 'Find Next Empty Spot Dim Check, Number Check = True: Number = 0 ' Initialize Values Do 'Outer loop ActiveCell.Offset(0, 1).Select If IsEmpty(ActiveCell.Offset(-1, 0).Value) Then MsgBox ("yes,it's empty") Check = False End If Loop Until Check = False 'Exit outer loop condition End Sub --- Dim Check, Number, Origin Check = True: Number = 0: Origin = ActiveCell.Address 'Initialize Values Do 'Outer loop ActiveCell.Offset(-1, 0).Select If IsEmpty(ActiveCell.Offset(-1, 0).Value) Then 'If IsNumeric(ActiveCell MsgBox (Origin) Check = False End If Loop Until Check = False 'Exit outer loop condition Origin = Number End Sub --- Sub Get_Total() ' ' Get_Total Macro ' Macro recorded 11/24/2003 by DonnyY ' ' Keyboard Shortcut: Ctrl+t ' Dim Check, Number, Origin, Sentence Check = True: Number = 0: Origin = ActiveCell.Address: Sentence = "=0" 'Initialize Values Do ActiveCell.Offset(-1, 0).Select If IsEmpty(ActiveCell.Offset(0, 0).Value) Then ActiveCell.Offset(-1, 0).Select If IsNumeric(ActiveCell.Offset(0, 0).Value) And (ActiveCell.Offset(0, 0).Value <> "") Then Number = Number + ActiveCell.Offset.Value Sentence = Sentence + " + " + Right(ActiveCell.Address, Len(ActiveCell.Address) - 1) MsgBox (Right(ActiveCell.Address, Len(ActiveCell.Address) - 1)) Else Check = False End If End If Loop While Check = True 'Exit outer loop condition Range(Origin) = Sentence 'Number Range(Origin).Select ActiveCell.Offset(0, 1).Select 'MsgBox (Sentence) End Sub --- Sub Add_Function() ' ' Add_Function Macro ' Macro recorded 11/24/2003 by DonnyY ' Add additional items to a function of a cell ' ' ActiveCell.FormulaR1C1 = "if(4=0,1,0)" ' Range("H11:I12").Select ' Range("H12").Activate Dim oCell As Range For Each oCell In Selection 'If ("=" = "=") Then 'MsgBox (Left(oCell.Formula, 1)) 'MsgBox (Len(oCell.Formula)) If (Left(oCell.Formula, 1) = "=") Then oCell.Formula = "=" + "a" + Right(oCell.Formula, Len(oCell.Formula) - 1) + "b" Else oCell.Formula = "a" + oCell.Formula + "b" End If Next End Sub ------------------------