Wednesday, March 22, 2017

macro to set cell background color

Sub RoundToZero1()
    For Counter = 1 To 300
        For Col = 1 To 50
            Set curCell = Worksheets("Assets").Cells(Counter, Col)
            If curCell.Interior.Color = 12639228 Then  'RGB(252, 219, 192) Then
                curCell.Interior.Color = RGB(210, 231, 197)
            End If
            If curCell.Interior.Color = 2327285 Then  'RGB(252, 219, 192) Then
                curCell.Interior.Color = RGB(96, 148, 61)
            End If
            'If Abs(curCell.Value) < 0.01 Then curCell.Value = 0
        Next Col
    Next Counter
    For Counter = 1 To 300
        For Col = 1 To 50
            Set curCell = Worksheets("Liabilities").Cells(Counter, Col)
            If curCell.Interior.Color = 12639228 Then  'RGB(252, 219, 192) Then
                curCell.Interior.Color = RGB(210, 231, 197)
            End If
            If curCell.Interior.Color = 2327285 Then  'RGB(252, 219, 192) Then
                curCell.Interior.Color = RGB(96, 148, 61)
            End If
            'If Abs(curCell.Value) < 0.01 Then curCell.Value = 0
        Next Col
    Next Counter
    For Counter = 1 To 300
        For Col = 1 To 50
            Set curCell = Worksheets("IncomeStatement").Cells(Counter, Col)
            If curCell.Interior.Color = 12639228 Then  'RGB(252, 219, 192) Then
                curCell.Interior.Color = RGB(210, 231, 197)
            End If
            If curCell.Interior.Color = 2327285 Then  'RGB(252, 219, 192) Then
                curCell.Interior.Color = RGB(96, 148, 61)
            End If
            'If Abs(curCell.Value) < 0.01 Then curCell.Value = 0
        Next Col
    Next Counter
    For Counter = 1 To 300
        For Col = 1 To 50
            Set curCell = Worksheets("Expenses").Cells(Counter, Col)
            If curCell.Interior.Color = 12639228 Then  'RGB(252, 219, 192) Then
                curCell.Interior.Color = RGB(210, 231, 197)
            End If
            If curCell.Interior.Color = 2327285 Then  'RGB(252, 219, 192) Then
                curCell.Interior.Color = RGB(96, 148, 61)
            End If
            'If Abs(curCell.Value) < 0.01 Then curCell.Value = 0
        Next Col
    Next Counter
    For Counter = 1 To 300
        For Col = 1 To 50
            Set curCell = Worksheets("IncomeDeductions").Cells(Counter, Col)
            If curCell.Interior.Color = 12639228 Then  'RGB(252, 219, 192) Then
                curCell.Interior.Color = RGB(210, 231, 197)
            End If
            If curCell.Interior.Color = 2327285 Then  'RGB(252, 219, 192) Then
                curCell.Interior.Color = RGB(96, 148, 61)
            End If
            'If Abs(curCell.Value) < 0.01 Then curCell.Value = 0
        Next Col
    Next Counter
    For Counter = 1 To 300
        For Col = 1 To 50
            Set curCell = Worksheets("TurnoverRatios").Cells(Counter, Col)
            If curCell.Interior.Color = 12639228 Then  'RGB(252, 219, 192) Then
                curCell.Interior.Color = RGB(210, 231, 197)
            End If
            If curCell.Interior.Color = 2327285 Then  'RGB(252, 219, 192) Then
                curCell.Interior.Color = RGB(96, 148, 61)
            End If
            'If Abs(curCell.Value) < 0.01 Then curCell.Value = 0
        Next Col
    Next Counter
    For Counter = 1 To 300
        For Col = 1 To 50
            Set curCell = Worksheets("EquipmentDetailUsed").Cells(Counter, Col)
            If curCell.Interior.Color = 12639228 Then  'RGB(252, 219, 192) Then
                curCell.Interior.Color = RGB(210, 231, 197)
            End If
            If curCell.Interior.Color = 2327285 Then  'RGB(252, 219, 192) Then
                curCell.Interior.Color = RGB(96, 148, 61)
            End If
            'If Abs(curCell.Value) < 0.01 Then curCell.Value = 0
        Next Col
    Next Counter

    MsgBox "Completed"
End Sub




Friday, March 17, 2017

Macro to List All Formulas in Workbook

http://blog.contextures.com/archives/2012/09/27/list-all-formulas-in-workbook/

List All Formulas in Workbook

If you’re working on a complicated Excel file, or taking over a file that someone else built, it can be difficult to understand how it all fits together.
formulalist03 
To get started, you can see where the formulas and constants are located, and colour code those cells.
Copy of formatformulas09 

View Formulas on the Worksheet

You can also view the formulas on a worksheet, by using the Ctrl + ` shortcut. And if you open another window in the workbook, you can view formulas and results at the same time.
FormulaView03

Code to List Formulas

For more details on how the calculations work, you can use programming to create a list of all the formulas on each worksheet.
In the following sample code, a new sheet is created for each worksheet that contains formulas. The new sheet is named for the original sheet, with the prefix "F_".
In the formula list sheet, there is an ID column, that you can use to restore the list to its original order, after you’ve sorted by another column.
There are also columns with the worksheet name, the formula’s cell, the formula and the formula in R1C1 format.
formulalist02 
Copy the following code to a regular module in your workbook.
Sub ListAllFormulas()
'print the formulas in the active workbook
Dim lRow As Long
Dim wb As Workbook
Dim ws As Worksheet
Dim wsNew As Worksheet
Dim c As Range
Dim rngF As Range
Dim strNew As String
Dim strSh As String
On Error Resume Next
Application.DisplayAlerts = False

Set wb = ActiveWorkbook
strSh = "F_"

For Each ws In wb.Worksheets
  lRow = 2
  
  If Left(ws.Name, Len(strSh)) <> strSh Then
    Set rngF = Nothing
    On Error Resume Next
    Set rngF = ws.Cells.SpecialCells(xlCellTypeFormulas, 23)
    If Not rngF Is Nothing Then
      strNew = Left(strSh & ws.Name, 30)
      Worksheets(strNew).Delete
      Set wsNew = Worksheets.Add
      With wsNew
        .Name = strNew
        .Columns("A:E").NumberFormat = "@" 'text format
        .Range(.Cells(1, 1), .Cells(1, 5)).Value _
            = Array("ID", "Sheet", "Cell", "Formula", "Formula R1C1")
        For Each c In rngF
          .Range(.Cells(lRow, 1), .Cells(lRow, 5)).Value _
            = Array(lRow - 1, ws.Name, c.Address(0, 0), _
              c.Formula, c.FormulaR1C1)
          lRow = lRow + 1
        Next c
        .Rows(1).Font.Bold = True
        .Columns("A:E").EntireColumn.AutoFit
      End With 'wsNew
      Set wsNew = Nothing
    End If
  
  End If
Next ws
  
Application.DisplayAlerts = True

End Sub

Code to Remove Formula Sheets

In the List Formulas code, formula sheets are deleted, before creating a new formula sheet. However, if you want to delete the formula sheets without creating a new set, you can run the following code.
Sub ClearFormulaSheets()
'remove formula sheets created by
'ShowFormulas macro
Dim wb As Workbook
Dim ws As Worksheet
Dim strSh As String
On Error Resume Next
Application.DisplayAlerts = False

Set wb = ActiveWorkbook
strSh = "F_"

Set wb = ActiveWorkbook
  For Each ws In wb.Worksheets
    If Left(ws.Name, Len(strSh)) = strSh Then
      ws.Delete
    End If
  Next ws
  
Application.DisplayAlerts = True

End Sub

Wednesday, March 8, 2017

Query to Display Foreign Key Relationships and Name of the Constraint for Each Table in Database

https://blog.sqlauthority.com/2006/11/01/sql-server-query-to-display-foreign-key-relationships-and-name-of-the-constraint-for-each-table-in-database/

SELECTK_Table FK.TABLE_NAME,FK_Column CU.COLUMN_NAME,PK_Table PK.TABLE_NAME,PK_Column PT.COLUMN_NAME,Constraint_Name C.CONSTRAINT_NAMEFROM INFORMATION_SCHEMA.REFERENTIAL_CONSTRAINTS CINNER JOIN INFORMATION_SCHEMA.TABLE_CONSTRAINTS FK ON C.CONSTRAINT_NAME FK.CONSTRAINT_NAMEINNER JOIN INFORMATION_SCHEMA.TABLE_CONSTRAINTS PK ON C.UNIQUE_CONSTRAINT_NAME PK.CONSTRAINT_NAMEINNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE CU ON C.CONSTRAINT_NAME CU.CONSTRAINT_NAMEINNER JOIN (SELECT i1.TABLE_NAMEi2.COLUMN_NAMEFROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS i1INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE i2 ON i1.CONSTRAINT_NAME i2.CONSTRAINT_NAMEWHERE i1.CONSTRAINT_TYPE 'PRIMARY KEY'PT ON PT.TABLE_NAME PK.TABLE_NAME---- optional:ORDER BY1,2,3,4WHERE PK.TABLE_NAME='something'WHERE FK.TABLE_NAME='something'WHERE PK.TABLE_NAME IN ('one_thing''another')WHERE FK.TABLE_NAME IN ('one_thing''another')