Locating bold text in excel using R - r

Question

I am trying to make a couple of spreadsheets in excel accessible. I need to replace bold text and some contents of the cells depending on their specific grouping. For example, if I have this table:
I would like to have the equivalent "accessible" table:
I am not worried about writing in the excel file, my goal is to read the table from the spreadsheet and create a data frame that looks like the table above with the variable names in the first column.
My idea was to identify where there is a bold text in the first column so I could prepend that text to the names that are not in bold as bold represents the subgroups.
I understand this might not be the best solution to the problem, I hope someone can find a proper solution.
Thank you all very much.

Answer 1

--EDITED -- it turns out you can tell the style of which cell has which style and depending on how many styles/how consistent the styles are used in the workbook would determine your needs. But I will leave the other answer using the Total column approach below. The first approach relies on the bold text being consistently used. And the second approach relies on the Total column subcategories always equaling the total categories. The both end up using similar approaches, just initial strategy of identifying the category text is different with each approach.
---I don't believe that openxlsx can determine which cells have a bolded style-- only that a bolded style exists in the workbook.--- I couldn't have been more wrong!
---Bold text search answer --
library(openxlsx)
library(tidyverse)
wb <- createWorkbook()
wb <- loadWorkbook("Path\\Your_File_Name.xlsx")
#Examine structure of the workbook
str(wb)
#Tells number of styles in workbook
wb$styleObjects %>% length()
#In this example there is just 1 style. So index the 1st style below this text logical if fontDecoration is bolded (answer is TRUE)
wb$styleObjects[[1]]$style$fontDecoration == "BOLD"
Since this is the style desired, pull out the rows that have this fontDecoration. Note if BOLD and other style type in different cell (e.g., Motorcycle was in red font) then this may get more complex in flagging/collecting the rows with bolded font (hence approach 2 may be safer option).
#This indicates that rows 1 and 5 have bolded text (i.e., Car and Motorcycle)
thesebold <- wb$styleObjects[[1]]$rows
df <- read.xlsx("Path\\filename", colNames = FALSE)
This identifies number of repetitions each category should have. So taking different between row position 1 and 5, then remaining length of the dataset. See second approach if more than two categories
thesereps <- c(diff(thesebold), dim(df)[1] - diff(thesebold))
#Named variables for ease
df %>%
set_names("Category", "Total") %>%
bind_cols(newcat = rep(df[thesebold,1], thesereps)) %>%
mutate(Category = case_when(Category == newcat ~ Category,
Category != newcat ~ paste0(newcat, ":", Category))) %>%
select(-newcat)
--Second approach --
So, this answer isn't using the bold text approach, but assuming the structure of the dataset is how you have it displayed in the example, then the below should work. The data are structured where you have categories (Car, Motorcycle) then subcategories (Tesla, Honda, Toyota, etc.) with the Total column being Total for each category, then subcategory subtotal that contributes to the Total. Using this column, you can define category boundaries (i.e., when subtracting Total from itself, it reaches 0 before switching to the next category). For demo, I added two more categories of varying lengths but same restrictions (sum of subcategories' totals must equal category total). I made a note where things may need adjusted for your purposes since I am creating the dataframe from scratch instead of reading it in using openxlsx
library(tidyverse)
#Make expanded data set for demo - adding extra categories
thesenames = c("Car", "Tesla", "Honda", "Toyota", "Motorcylce", "Honda", "Yamaha", "Suzuki", "Fruit", "Apple", "Orange", "Grape", "Strawberry", "Lemon", "Lime", "Shape", "Circle", "Square", "Octogon")
thesetotals = c(12,3,2,7,20,13,5,2, 32, 8, 4, 4, 8, 4, 4, 24, 2, 4, 18)
df <- bind_cols(thesenames, thesetotals)%>%
set_names("Type", "Total")
#Empty tibble to save running total result to
y <- tibble(NULL)
#Initialize the current.total as 0
current.total = 0
for(i in thesetotals){
if (current.total == 0){
current.total = current.total + i
} else{
current.total = current.total - i
}
tmp <- current.total
y <- rbind(y, tmp)
}
y <- as_tibble(y) %>%
set_names("RT")
#Gets the number of subcategories between each of main categories
thislong <- c(diff(which(y$RT ==0)))
thislong <- c((length(y$RT) - sum(thislong)),thislong)
#This part assumes the structure of the df I created above which may need modified in your dataset
#This pulls from first column, first row, which here is "Car"
firstrow <- df[1,1] %>% pull()
#Gets vector of each category; determines category by looking at the lag RT value
thesetypes <- bind_cols(df,y) %>%
mutate(Category = case_when(firstrow == Type ~ Type,
RT > lag(RT) ~ Type,
TRUE ~ "0")) %>%
filter(Category != "0") %>%
pull(Category)
#Adds new category to existing df, repeating the specified number of times
df$Category <- rep(thesetypes,thislong)
#Modifies the subcategory text with prefixing the category membership then drops Category
df <- df %>%
mutate(Type = case_when(Type != Category ~ paste0(Category, ":", Type),
TRUE ~ Type)) %>%
select(-Category)
df