R: Save a dataframe als xlsx with each group a separate sheet

save-df-as-xlsx-group-var-as-sheet.R

# Save a dataframe als xlsx with each group a separate sheet
# plus formatting and highlighting

library(dplyr)
library(purrr)
library(openxlsx)

# some configs

filename <- "test.xlsx"
data <- diamonds %>% rename(group = cut)
string_to_highlight <- "setosa"
index_col_to_highlight <- 5 

# 1) list of dataframes: every list will be a sheet
list <- data %>% group_split(group)

# 2) name dataframes: will be sheet names
# Dataframes innerhalb der Liste benennen
names(list) <- list %>%
  purrr::map(~pull(., group)) %>% 
  purrr::map(~as.character(.)) %>% # Convert factor to character
  purrr::map(~unique(.))

# 3) Save every dataframe in list as a new sheet
# Formatting:
# - Fix first row
# - add filter for columns
# - color for column names
# - auto width for columns, depending on cell values
wb <- createWorkbook()
purrr::iwalk(
  .x = list,
  .f = function(df, object_name) {
    
    header_style_fix <- createStyle(
      textDecoration = "bold", halign = "center", fgFill = "#B6EAFA", border = "Bottom"
    )
    
    header_style_check <- createStyle(
      textDecoration = "bold", halign = "center", fgFill = "#FAC2B6", border = "Bottom"
    )
    
    addWorksheet(wb = wb, sheetName = object_name)
    writeData(wb = wb, sheet = object_name, x = df)
    # freeze first row
    freezePane(wb = wb, sheet = object_name, firstRow = TRUE)
    # auto width depending on content
    setColWidths(wb, sheet = object_name, cols = 1:ncol(data), widths = "auto")
    # different colors for headers
    addStyle(wb, sheet = object_name, header_style_fix, rows = 1, cols = 1:ncol(data))
    # add filter
    addFilter(wb, sheet = object_name, row = 1, cols = 1:ncol(data))
    # conditional coloring: Color when string_to_highlight is found
    conditionalFormatting(wb, sheet = object_name, cols = index_col_to_highlight, rows = 1:nrow(data),
                          type = "contains", rule = string_to_highlight)
  }
)
unlink(filename)
saveWorkbook(wb = wb, file = filename)
fs::file_show(filename)