Excel anyone?

I've developed lots of content using Tableau, OBIEE, and a host of other export and reporting tools over the years that work well but are also expensive. The fact remains that Excel is seemingly everywhere. With that said, I've built a tremendous amount of Excel tooling for a myriad of reasons over these past couple of years. So, here's a library of my favorite code snippets that I use constantly.


My Own Starter Sheet Template (read on below)

I work with a starter sheet of my own hot key macros. There are certain routines I use constantly:
  • Copy a formula down x rows based on the depth of the column to the left.
  • Set an entire column of values to the Accounting format with no $ sign.
  • Convert an entire column of formulas to just values.
  • After VLOOKUPs in the rightmost column, sort the range of data so all the #N/A's fall to the bottom.
  • Toggle a row highlight in yellow - on and off.

COPY A FORMULA DOWN A COLUMN
Why: when some column X has a lot of data (let's say 25,000 rows) and I want to copy down  a new formula in column Y, one column to the right. I do this constantly. For this, I like to assign CTRL+SHIFT+K ( scroll to the bottom to see how to assign hot keys )
Sub CopyThatDown()        
   thisrow = ActiveCell.Row     
   thiscolumn = ActiveCell.Column     
   ActiveCell.Offset(ColumnOffset:=-1).Activate     
   ActiveSheet.Range(Selection, Selection.End(xlDown)).Select     
   allrows = Selection.Rows.Count     
   ActiveCell.Offset(RowOffset:=allrows - 1, ColumnOffset:=1).Activate     
   lastrow = ActiveCell.Row ActiveCell.Value = "x"     
   ActiveCell.Offset(RowOffset:=(thisrow - lastrow)).Activate     
   Selection.Copy ActiveCell.Offset(RowOffset:=1).Activate     
   ActiveSheet.Range(Selection, Selection.End(xlDown)).Select     
   ActiveSheet.Paste     
   Application.CutCopyMode = False     
   ActiveCell.Offset(RowOffset:=-1).Activate 
End Sub  

SET A COLUMN OF VALUES TO THE ACCOUNTING FORMAT
For this, I like to assign CTRL+SHIFT+J ( scroll to the bottom to see how to assign hot keys )

Sub DollarsAndCents()  
   ActiveSheet.Range(Selection, Selection.End(xlDown)).Select         
   Selection.NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"    
   ActiveCell.Offset(ColumnOffset:=1).Activate
   ActiveCell.Offset(ColumnOffset:=-1).Activate
End Sub

CONVERT COLUMN FORMULAS, PASTE VALUES
For this, I like to assign CTRL+SHIFT+N ( scroll to the bottom to see how to assign hot keys )

Sub ValuePaster()      
   thisrow = ActiveCell.Row     
   thiscolumn = ActiveCell.Column     
   ActiveSheet.Cells(thisrow, thiscolumn).Select     
   ActiveSheet.Range(Selection, Selection.End(xlDown)).Select     
   Selection.Copy     
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _  
      :=False, Transpose:=False     
   Application.CutCopyMode = False     
   ActiveSheet.Cells(thisrow, thiscolumn).Select   
End Sub

SORT RIGHT-COLUMN VLOOKUP #N/A's TO THE BOTTOM
For this, I like to assign CTRL+SHIFT+M ( scroll to the bottom to see how to assign hot keys )

Sub VlookerSort()      
   Dim r As Range
   thisrow = ActiveCell.Row     
   thiscolumn = ActiveCell.Column     
   ActiveSheet.Cells(thisrow, thiscolumn).CurrentRegion.Select     
   Set r = Selection     
   nFirstRow = thisrow     
   nFirstColumn = r.Column     
   nLastRow = r.Rows.Count + r.Row - 1     
   nLastColumn = thiscolumn     
   ActiveSheet.Sort.SortFields.Clear     
   ActiveSheet.Sort.SortFields.Add Key:=Range(Cells(nFirstRow, nLastColumn), _
      Cells(nLastRow, nLastColumn)) , SortOn:=xlSortOnValues, _
      Order:=xlAscending, DataOption:=xlSortNormal     
   With ActiveSheet.Sort        
      .SetRange Range(Cells(nFirstRow, nFirstColumn), Cells(nLastRow, nLastColumn))       
      .Header = xlGuess       
      .MatchCase = False       
      .Orientation = xlTopToBottom       
      .SortMethod = xlPinYin       
      .Apply     
   End With     
   ActiveSheet.Cells(thisrow, thiscolumn).Select     
   x = thisrow     
   Do While x <= nLastRow       
      ActiveCell.Offset(RowOffset:=1).Activate        
      If Trim(ActiveCell.Text) = "#N/A" Then  
         Exit Do 
      End If   
      x = x + 1  
   Loop 
End Sub

HIGHLIGHT A ROW IN YELLOW (toggle yellow background on and off)
For this, I like to assign CTRL+SHIFT+Y ( scroll to the bottom to see how to assign hot keys )

Sub HighlightRow()     
   Dim r As Range 
   thisrow = ActiveCell.Row     
   thiscolumn = ActiveCell.Column     
   If ActiveCell.Interior.ColorIndex = 6 Then        
      ThisRowIsYellow = True     
   End If 
   ActiveSheet.Cells(thisrow, thiscolumn).CurrentRegion.Select
   Set r = Selection 
   nFirstRow = thisrow   
   nFirstColumn = r.Column
   nLastRow = r.Rows.Count + r.Row - 1   
   nLastColumn = r.Columns.Count + r.Column - 1     
   'Select     
   ActiveSheet.Range(Cells(thisrow, nFirstColumn), Cells(thisrow, nLastColumn)).Select     
   'color rows     
   If ThisRowIsYellow Then     
      'Set back to no yellow   
      With Selection.Interior    
         .Pattern = xlNone    
         .TintAndShade = 0    
         .PatternTintAndShade = 0   
      End With  
      Selection.Borders.LineStyle = xlNone     
   Else    
      'Set cell backgrounds to yellow   
      With Selection.Interior    
         .Pattern = xlSolid      
         .PatternColorIndex = xlAutomatic    
         .Color = 65535    
         .TintAndShade = 0   
         .PatternTintAndShade = 0   
      End With   
      Selection.Borders(xlDiagonalDown).LineStyle = xlNone  
      Selection.Borders(xlDiagonalUp).LineStyle = xlNone  
      With Selection.Borders(xlEdgeLeft)    
         .LineStyle = xlContinuous     
         .ThemeColor = 1    
         .TintAndShade = -0.249946592608417    
         .Weight = xlThin  
      End With  
      With Selection.Borders(xlEdgeTop)  
         .LineStyle = xlContinuous     
         .ThemeColor = 1   
         .TintAndShade = -0.249946592608417  
         .Weight = xlThin 
     End With  
     With Selection.Borders(xlEdgeBottom)   
         .LineStyle = xlContinuous   
         .ThemeColor = 1   
         .TintAndShade = -0.249946592608417  
         .Weight = xlThin  
     End With 
     With Selection.Borders(xlEdgeRight)  
         .LineStyle = xlContinuous    
         .ThemeColor = 1   
         .TintAndShade = -0.249946592608417   
         .Weight = xlThin  
     End With 
     With Selection.Borders(xlInsideVertical)  
         .LineStyle = xlContinuous   
         .ThemeColor = 1   
         .TintAndShade = -0.249946592608417   
         .Weight = xlThin  
     End With  
     Selection.Borders(xlInsideHorizontal).LineStyle = xlNone  
   End If   
   ActiveSheet.Cells(thisrow, thiscolumn).Select
End Sub

ASSIGNING HOT KEYS FOR MACROS
In order for my hot key macros to be active when you open an Excel xlsm file, all of the Subs described above need to be defined in a module (like Module1), not a Sheet, and the hot keys (like CTRL+SHIFT+N) have to be defined using the Application.Onkey function. In addition, the Workbook_Open() event needs to call the sub that defines all the hot keys (in my case CreateShortcut() ) from "ThisWorkbook" Object. Then save the xlsm and reopen. The hot key macros will then be active.

Define the hot keys with Application.OnKey declarations. Remember, these go in Module1

Sub CreateShortcut()     
   Application.OnKey "+^{N}", "ValuePaster"     
   Application.OnKey "+^{J}", "DollarsAndCents" 
   Application.OnKey "+^{K}", "CopyThatDown"    
   Application.OnKey "+^{M}", "VLookerSort"    
   Application.OnKey "+^{Y}", "HighlightRow" 
End Sub

Then, call the CreateShortcut sub from ThisWorkbook:

Private Sub Workbook_Open()    
   Call Module1.CreateShortcut 
End Sub

 
Search