openxlsx
Read, Write and Edit xlsx Files

Package index
Search the openxlsx package
Vignettes
Functions
305
Source code
91
Man pages
80
Home
/
CRAN
/
openxlsx
/
R/conditional_formatting.R

R/conditional_formatting.R
In openxlsx: Read, Write and Edit xlsx Files

Defines functions conditionalFormatting

Documented in conditionalFormatting 

#' @name conditionalFormatting
#' @aliases databar
#' @title Add conditional formatting to cells
#' @description Add conditional formatting to cells
#' @author Alexander Walker, Philipp Schauberger
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param cols Columns to apply conditional formatting to
#' @param rows Rows to apply conditional formatting to
#' @param rule The condition under which to apply the formatting. See examples.
#' @param style A style to apply to those cells that satisfy the rule. Default is createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE")
#' @param type Either 'expression', 'colourScale', 'databar', 'duplicates', 'beginsWith',
#' 'endsWith', 'topN', 'bottomN', 'contains' or 'notContains' (case insensitive).
#' @param ... See below
#' @details See Examples.
#'
#' If type == "expression"
#' \itemize{
#'   \item{style is a Style object. See [createStyle()]}
#'   \item{rule is an expression. Valid operators are "<", "<=", ">", ">=", "==", "!=".}
#' }
#'
#' If type == "colourScale"
#' \itemize{
#'   \item{style is a vector of colours with length 2 or 3}
#'   \item{rule can be NULL or a vector of colours of equal length to styles}
#' }
#'
#' If type == "databar"
#' \itemize{
#'   \item{style is a vector of colours with length 2 or 3}
#'   \item{rule is a numeric vector specifying the range of the databar colours. Must be equal length to style}
#'   \item{...
#'   \itemize{
#'     \item{**showvalue** If FALSE the cell value is hidden. Default TRUE.}
#'     \item{**gradient** If FALSE colour gradient is removed. Default TRUE.}
#'     \item{**border** If FALSE the border around the database is hidden. Default TRUE.}
#'      }
#'    }
#' }
#'
#' If type == "duplicates"
#' \itemize{
#'   \item{style is a Style object. See [createStyle()]}
#'   \item{rule is ignored.}
#' }
#'
#' If type == "contains"
#' \itemize{
#'   \item{style is a Style object. See [createStyle()]}
#'   \item{rule is the text to look for within cells}
#' }
#'
#' If type == "between"
#' \itemize{
#'   \item{style is a Style object. See [createStyle()]}
#'   \item{rule is a numeric vector of length 2 specifying lower and upper bound (Inclusive)}
#' }
#'
#' If type == "topN"
#' \itemize{
#'   \item{style is a Style object. See [createStyle()]}
#'   \item{rule is ignored}
#'   \item{...
#'   \itemize{
#'     \item{**rank** numeric vector of length 1 indicating number of highest values.}
#'     \item{**percent** TRUE if you want top N percentage.}
#'      }
#'    }
#' }
#'
#' If type == "bottomN"
#' \itemize{
#'   \item{style is a Style object. See [createStyle()]}
#'   \item{rule is ignored}
#'   \item{...
#'   \itemize{
#'     \item{**rank** numeric vector of length 1 indicating number of lowest values.}
#'     \item{**percent** TRUE if you want bottom N percentage.}
#'      }
#'    }
#' }
#'
#' @seealso [createStyle()]
#' @export
#' @examples
#' wb <- createWorkbook()
#' addWorksheet(wb, "cellIs")
#' addWorksheet(wb, "Moving Row")
#' addWorksheet(wb, "Moving Col")
#' addWorksheet(wb, "Dependent on")
#' addWorksheet(wb, "Duplicates")
#' addWorksheet(wb, "containsText")
#' addWorksheet(wb, "notcontainsText")
#' addWorksheet(wb, "beginsWith")
#' addWorksheet(wb, "endsWith")
#' addWorksheet(wb, "colourScale", zoom = 30)
#' addWorksheet(wb, "databar")
#' addWorksheet(wb, "between")
#' addWorksheet(wb, "topN")
#' addWorksheet(wb, "bottomN")
#' addWorksheet(wb, "logical operators")
#'
#' negStyle <- createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE")
#' posStyle <- createStyle(fontColour = "#006100", bgFill = "#C6EFCE")
#'
#' ## rule applies to all each cell in range
#' writeData(wb, "cellIs", -5:5)
#' writeData(wb, "cellIs", LETTERS[1:11], startCol = 2)
#' conditionalFormatting(wb, "cellIs",
#'   cols = 1,
#'   rows = 1:11, rule = "!=0", style = negStyle
#' )
#' conditionalFormatting(wb, "cellIs",
#'   cols = 1,
#'   rows = 1:11, rule = "==0", style = posStyle
#' )
#'
#' ## highlight row dependent on first cell in row
#' writeData(wb, "Moving Row", -5:5)
#' writeData(wb, "Moving Row", LETTERS[1:11], startCol = 2)
#' conditionalFormatting(wb, "Moving Row",
#'   cols = 1:2,
#'   rows = 1:11, rule = "$A1<0", style = negStyle
#' )
#' conditionalFormatting(wb, "Moving Row",
#'   cols = 1:2,
#'   rows = 1:11, rule = "$A1>0", style = posStyle
#' )
#'
#' ## highlight column dependent on first cell in column
#' writeData(wb, "Moving Col", -5:5)
#' writeData(wb, "Moving Col", LETTERS[1:11], startCol = 2)
#' conditionalFormatting(wb, "Moving Col",
#'   cols = 1:2,
#'   rows = 1:11, rule = "A$1<0", style = negStyle
#' )
#' conditionalFormatting(wb, "Moving Col",
#'   cols = 1:2,
#'   rows = 1:11, rule = "A$1>0", style = posStyle
#' )
#'
#' ## highlight entire range cols X rows dependent only on cell A1
#' writeData(wb, "Dependent on", -5:5)
#' writeData(wb, "Dependent on", LETTERS[1:11], startCol = 2)
#' conditionalFormatting(wb, "Dependent on",
#'   cols = 1:2,
#'   rows = 1:11, rule = "$A$1<0", style = negStyle
#' )
#' conditionalFormatting(wb, "Dependent on",
#'   cols = 1:2,
#'   rows = 1:11, rule = "$A$1>0", style = posStyle
#' )
#'
#' ## highlight cells in column 1 based on value in column 2
#' writeData(wb, "Dependent on", data.frame(x = 1:10, y = runif(10)), startRow = 15)
#' conditionalFormatting(wb, "Dependent on",
#'   cols = 1,
#'   rows = 16:25, rule = "B16<0.5", style = negStyle
#' )
#' conditionalFormatting(wb, "Dependent on",
#'   cols = 1,
#'   rows = 16:25, rule = "B16>=0.5", style = posStyle
#' )
#'
#'
#' ## highlight duplicates using default style
#' writeData(wb, "Duplicates", sample(LETTERS[1:15], size = 10, replace = TRUE))
#' conditionalFormatting(wb, "Duplicates", cols = 1, rows = 1:10, type = "duplicates")
#'
#' ## cells containing text
#' fn <- function(x) paste(sample(LETTERS, 10), collapse = "-")
#' writeData(wb, "containsText", sapply(1:10, fn))
#' conditionalFormatting(wb, "containsText", cols = 1, rows = 1:10, type = "contains", rule = "A")
#'
#' ## cells not containing text
#' fn <- function(x) paste(sample(LETTERS, 10), collapse = "-")
#' writeData(wb, "containsText", sapply(1:10, fn))
#' conditionalFormatting(wb, "notcontainsText", cols = 1,
#'                      rows = 1:10, type = "notcontains", rule = "A")
#'
#'
#' ## cells begins with text
#' fn <- function(x) paste(sample(LETTERS, 10), collapse = "-")
#' writeData(wb, "beginsWith", sapply(1:100, fn))
#' conditionalFormatting(wb, "beginsWith", cols = 1, rows = 1:100, type = "beginsWith", rule = "A")
#'
#'
#' ## cells ends with text
#' fn <- function(x) paste(sample(LETTERS, 10), collapse = "-")
#' writeData(wb, "endsWith", sapply(1:100, fn))
#' conditionalFormatting(wb, "endsWith", cols = 1, rows = 1:100, type = "endsWith", rule = "A")
#'
#' ## colourscale colours cells based on cell value
#' df <- read.xlsx(system.file("extdata", "readTest.xlsx", package = "openxlsx"), sheet = 4)
#' writeData(wb, "colourScale", df, colNames = FALSE) ## write data.frame
#'
#' ## rule is a vector or colours of length 2 or 3 (any hex colour or any of colours())
#' ## If rule is NULL, min and max of cells is used. Rule must be the same length as style or NULL.
#' conditionalFormatting(wb, "colourScale",
#'   cols = 1:ncol(df), rows = 1:nrow(df),
#'   style = c("black", "white"),
#'   rule = c(0, 255),
#'   type = "colourScale"
#' )
#'
#' setColWidths(wb, "colourScale", cols = 1:ncol(df), widths = 1.07)
#' setRowHeights(wb, "colourScale", rows = 1:nrow(df), heights = 7.5)
#'
#' ## Databars
#' writeData(wb, "databar", -5:5)
#' conditionalFormatting(wb, "databar", cols = 1, rows = 1:11, type = "databar") ## Default colours
#'
#' ## Between
#' # Highlight cells in interval [-2, 2]
#' writeData(wb, "between", -5:5)
#' conditionalFormatting(wb, "between", cols = 1, rows = 1:11, type = "between", rule = c(-2, 2))
#'
#' ## Top N
#' writeData(wb, "topN", data.frame(x = 1:10, y = rnorm(10)))
#' # Highlight top 5 values in column x
#' conditionalFormatting(wb, "topN", cols = 1, rows = 2:11,
#'  style = posStyle, type = "topN", rank = 5)#'
#' # Highlight top 20 percentage in column y
#' conditionalFormatting(wb, "topN", cols = 2, rows = 2:11,
#'  style = posStyle, type = "topN", rank = 20, percent = TRUE)
#'
#'## Bottom N
#' writeData(wb, "bottomN", data.frame(x = 1:10, y = rnorm(10)))
#' # Highlight bottom 5 values in column x
#' conditionalFormatting(wb, "bottomN", cols = 1, rows = 2:11,
#'  style = negStyle, type = "topN", rank = 5)
#' # Highlight bottom 20 percentage in column y
#' conditionalFormatting(wb, "bottomN", cols = 2, rows = 2:11,
#'  style = negStyle, type = "topN", rank = 20, percent = TRUE)
#'
#' ## Logical Operators
#' # You can use Excels logical Operators
#' writeData(wb, "logical operators", 1:10)
#' conditionalFormatting(wb, "logical operators",
#'   cols = 1, rows = 1:10,
#'   rule = "OR($A1=1,$A1=3,$A1=5,$A1=7)"
#' )
#' \dontrun{
#' saveWorkbook(wb, "conditionalFormattingExample.xlsx", TRUE)
#' }
#'
#'
#' #########################################################################
#' ## Databar Example
#'
#' wb <- createWorkbook()
#' addWorksheet(wb, "databar")
#'
#' ## Databars
#' writeData(wb, "databar", -5:5, startCol = 1)
#' conditionalFormatting(wb, "databar", cols = 1, rows = 1:11, type = "databar") ## Defaults
#'
#' writeData(wb, "databar", -5:5, startCol = 3)
#' conditionalFormatting(wb, "databar", cols = 3, rows = 1:11, type = "databar", border = FALSE)
#'
#' writeData(wb, "databar", -5:5, startCol = 5)
#' conditionalFormatting(wb, "databar",
#'   cols = 5, rows = 1:11,
#'   type = "databar", style = c("#a6a6a6"), showValue = FALSE
#' )
#'
#' writeData(wb, "databar", -5:5, startCol = 7)
#' conditionalFormatting(wb, "databar",
#'   cols = 7, rows = 1:11,
#'   type = "databar", style = c("#a6a6a6"), showValue = FALSE, gradient = FALSE
#' )
#'
#' writeData(wb, "databar", -5:5, startCol = 9)
#' conditionalFormatting(wb, "databar",
#'   cols = 9, rows = 1:11,
#'   type = "databar", style = c("#a6a6a6", "#a6a6a6"), showValue = FALSE, gradient = FALSE
#' )
#' \dontrun{
#' saveWorkbook(wb, file = "databarExample.xlsx", overwrite = TRUE)
#' }
#'
conditionalFormatting <-
  function(wb,
           sheet,
           cols,
           rows,
           rule = NULL,
           style = NULL,
           type = "expression",
           ...) {
    op <- get_set_options()
    on.exit(options(op), add = TRUE)

    type <- tolower(type)
    params <- list(...)

    if (type %in% c("colorscale", "colourscale")) {
      type <- "colorScale"
    } else if (type == "databar") {
      type <- "dataBar"
    } else if (type == "duplicates") {
      type <- "duplicatedValues"
    } else if (type == "contains") {
      type <- "containsText"
    } else if (type == "notcontains") {
      type <- "notContainsText"
    } else if (type == "beginswith") {
      type <- "beginsWith"
    } else if (type == "endswith") {
      type <- "endsWith"
    } else if (type == "between") {
      type <- "between"
    } else if (type == "topn") {
      type <- "topN"
    } else if (type == "bottomn") {
      type <- "bottomN"
    } else if (type != "expression") {
      stop(
        "Invalid type argument.  Type must be one of 'expression', 'colourScale', 'databar', 'duplicates', 'beginsWith', 'endsWith', 'contains' or 'notContains'"
      )
    }

    ## rows and cols
    if (!is.numeric(cols)) {
      cols <- convertFromExcelRef(cols)
    }
    rows <- as.integer(rows)


    ## check valid rule
    values <- NULL
    dxfId <- NULL

    if (type == "colorScale") {
      # type == "colourScale"
      # - style is a vector of colours with length 2 or 3
      # - rule specifies the quantiles (numeric vector of length 2 or 3), if NULL min and max are used

      if (is.null(style)) {
        stop("If type == 'colourScale', style must be a vector of colours of length 2 or 3.")
      }

      if (!inherits(style, "character")) {
        stop("If type == 'colourScale', style must be a vector of colours of length 2 or 3.")
      }

      if (!length(style) %in% 2:3) {
        stop("If type == 'colourScale', style must be a vector of length 2 or 3.")
      }

      if (!is.null(rule)) {
        if (length(rule) != length(style)) {
          stop("If type == 'colourScale', rule and style must have equal lengths.")
        }
      }

      style <-
        validateColour(style, errorMsg = "Invalid colour specified in style.")

      values <- rule
      rule <- style
    } else if (type == "dataBar") {
      # type == "databar"
      # - style is a vector of colours of length 2 or 3
      # - rule specifies the quantiles (numeric vector of length 2 or 3), if NULL min and max are used

      if (is.null(style)) {
        style <- "#638EC6"
      }

      if (!inherits(style, "character")) {
        stop("If type == 'dataBar', style must be a vector of colours of length 1 or 2.")
      }

      if (!length(style) %in% 1:2) {
        stop("If type == 'dataBar', style must be a vector of length 1 or 2.")
      }

      if (!is.null(rule)) {
        if (length(rule) != length(style)) {
          stop("If type == 'dataBar', rule and style must have equal lengths.")
        }
      }


      ## Additional parameters passed by ...
      if ("showValue" %in% names(params)) {
        params$showValue <- as.integer(params$showValue)
        if (is.na(params$showValue)) {
          stop("showValue must be 0/1 or TRUE/FALSE")
        }
      }

      if ("gradient" %in% names(params)) {
        params$gradient <- as.integer(params$gradient)
        if (is.na(params$gradient)) {
          stop("gradient must be 0/1 or TRUE/FALSE")
        }
      }

      if ("border" %in% names(params)) {
        params$border <- as.integer(params$border)
        if (is.na(params$border)) {
          stop("border must be 0/1 or TRUE/FALSE")
        }
      }

      style <-
        validateColour(style, errorMsg = "Invalid colour specified in style.")

      values <- rule
      rule <- style
    } else if (type == "expression") {
      # type == "expression"
      # - style = createStyle()
      # - rule is an expression to evaluate

      # rule <- gsub(" ", "", rule)
      rule <- replaceIllegalCharacters(rule)
      rule <- gsub("!=", "&lt;&gt;", rule)
      rule <- gsub("==", "=", rule)

      if (!grepl("[A-Z]", substr(rule, 1, 2))) {
        ## formula looks like "operatorX" , attach top left cell to rule
        rule <-
          paste0(getCellRefs(data.frame(
            "x" = min(rows), "y" = min(cols)
          )), rule)
      } ## else, there is a letter in the formula and apply as is

      if (is.null(style)) {
        style <-
          createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE")
      }

      if (!"Style" %in% class(style)) {
        stop("If type == 'expression', style must be a Style object.")
      }

      invisible(dxfId <- wb$addDXFS(style))
    } else if (type == "duplicatedValues") {
      # type == "duplicatedValues"
      # - style is a Style object
      # - rule is ignored

      if (is.null(style)) {
        style <-
          createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE")
      }

      if (!"Style" %in% class(style)) {
        stop("If type == 'duplicates', style must be a Style object.")
      }

      invisible(dxfId <- wb$addDXFS(style))
      rule <- style
    } else if (type == "containsText") {
      # type == "contains"
      # - style is Style object
      # - rule is text to look for

      if (is.null(style)) {
        style <-
          createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE")
      }


      if (!"character" %in% class(rule)) {
        stop("If type == 'contains', rule must be a character vector of length 1.")
      }

      if (!"Style" %in% class(style)) {
        stop("If type == 'contains', style must be a Style object.")
      }

      invisible(dxfId <- wb$addDXFS(style))
      values <- rule
      rule <- style
    } else if (type == "notContainsText") {
      # type == "contains"
      # - style is Style object
      # - rule is text to look for

      if (is.null(style)) {
        style <-
          createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE")
      }


      if (!"character" %in% class(rule)) {
        stop("If type == 'notContains', rule must be a character vector of length 1.")
      }

      if (!"Style" %in% class(style)) {
        stop("If type == 'notContains', style must be a Style object.")
      }

      invisible(dxfId <- wb$addDXFS(style))
      values <- rule
      rule <- style
    } else if (type == "beginsWith") {
      # type == "contains"
      # - style is Style object
      # - rule is text to look for

      if (is.null(style)) {
        style <-
          createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE")
      }


      if (!"character" %in% class(rule)) {
        stop("If type == 'beginsWith', rule must be a character vector of length 1.")
      }

      if (!"Style" %in% class(style)) {
        stop("If type == 'beginsWith', style must be a Style object.")
      }

      invisible(dxfId <- wb$addDXFS(style))
      values <- rule
      rule <- style
    } else if (type == "endsWith") {
      # type == "contains"
      # - style is Style object
      # - rule is text to look for

      if (is.null(style)) {
        style <-
          createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE")
      }


      if (!"character" %in% class(rule)) {
        stop("If type == 'endsWith', rule must be a character vector of length 1.")
      }

      if (!"Style" %in% class(style)) {
        stop("If type == 'endsWith', style must be a Style object.")
      }

      invisible(dxfId <- wb$addDXFS(style))
      values <- rule
      rule <- style
    } else if (type == "between") {
      rule <- range(rule)

      if (is.null(style)) {
        style <-
          createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE")
      }

      if (!"Style" %in% class(style)) {
        stop("If type == 'between', style must be a Style object.")
      }

      invisible(dxfId <- wb$addDXFS(style))
    } else if (type == "topN") {
      # type == "topN"
      # - rule is ignored
      # - 'rank' and 'percent' are named params

      if (is.null(style)) {
        style <-
          createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE")
      }

      if (!"Style" %in% class(style)) {
        stop("If type == 'topN', style must be a Style object.")
      }

      invisible(dxfId <- wb$addDXFS(style))

      ## Additional parameters passed by ...
      if ("percent" %in% names(params)) {
        params$percent <- as.integer(params$percent)
        if (is.na(params$percent)) {
          stop("percent must be 0/1 or TRUE/FALSE")
        }
      }

      if ("rank" %in% names(params)) {
        params$rank <- as.integer(params$rank)
        if (is.na(params$rank)) {
          stop("rank must be a number")
        }
      }

      invisible(dxfId <- wb$addDXFS(style))
      values <- params
      rule <- style
    } else if (type == "bottomN") {
      # type == "bottomN"
      # - rule is ignored
      # - 'rank' and 'percent' are named params

      if (is.null(style)) {
        style <-
          createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE")
      }

      if (!"Style" %in% class(style)) {
        stop("If type == 'bottomN', style must be a Style object.")
      }

      invisible(dxfId <- wb$addDXFS(style))

      ## Additional parameters passed by ...
      if ("percent" %in% names(params)) {
        params$percent <- as.integer(params$percent)
        if (is.na(params$percent)) {
          stop("percent must be 0/1 or TRUE/FALSE")
        }
      }

      if ("rank" %in% names(params)) {
        params$rank <- as.integer(params$rank)
        if (is.na(params$rank)) {
          stop("rank must be a number")
        }
      }

      invisible(dxfId <- wb$addDXFS(style))
      values <- params
      rule <- style
    }



    invisible(
      wb$conditionalFormatting(
        sheet,
        startRow = min(rows),
        endRow = max(rows),
        startCol = min(cols),
        endCol = max(cols),
        dxfId = dxfId,
        formula = rule,
        type = type,
        values = values,
        params = params
      )
    )

    invisible(0)
  }

Try the openxlsx package in your browser

Any scripts or data that you put into this service are public.

openxlsx documentation built on Feb. 16, 2023, 6:47 p.m.

R Package Documentation

rdrr.io home R language documentation Run R code online

Browse R Packages

CRAN packages Bioconductor packages R-Forge packages GitHub packages

We want your feedback!

Note that we can't provide technical support on individual packages. You should contact the package authors for that.
GitHub issue tracker
ian@mutexlabs.com
Personal blog

 
Embedding an R snippet on your website

Add the following code to your website.

For more information on customizing the embed code, read Embedding Snippets.

Close