Below is the excel data i have:
(Table 1) - each Project has mutiple rows and merged together
And i would like to make it like this:
(Table 2) - Each project has their own row
To unmerge those rows from merged rows to separate rows, I wrote two Macros
1. To unmerge the rows and copy the text from merged cell to the first corresponding cell (For example: Table 1 copy H8 & H9 to H7)
Sub ConcatenateRows_Generated() End Sub |
It will become like this:
Now you can see H8 & H9's text is copied to H7, but i need to delete Row 8 & 9 as its meaningless now.
2. remove all useless row
Sub DeleteEmptyRowsInRange_Updated() End Sub |
And now it become like this, each Project is using 1 row
However, the for that 3 columns for Date, they follow the first cell on each merged Project's row, so some of them become all strikethrough and some of them become underlined.
Anyone have any idea how can i combine those content without losing the format??
or can i reformat the text merged according to it's length for every cell i want it to combine?
Thank you very much~
I have come all the way to the final stage, but one thing that i am trying to solve now.
I attached my data below too.
When i try to run it line by line, i saw when it runs line 127 copy the date without strikethrough and paste it to the target cell, it removed the strikethrough for the strikethrough date too. but i am not sure why as my code is simply paste the value to the target cell and i expect it should follow the pervious strikethrough thats why my code unstrikethrough the date after pasting it to the target cell. but now it dont work because it DID NOT follow the pervious strikethrough format, it unstrikethrough the pervious date instead...
Before line 127 code: the Apr 18 date should be strikethrough and it is
After line 127 code: the Apr 18 date should be strikethrough and it is NOT
Sub Try1()
Dim lastRow As Long, mergedRows As Long
Dim i As Long, j As Long, k As Long
Sheets("Generated").Select
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 3 To lastRow
mergedRows = Range("A" & i).MergeArea.Rows.Count
If mergedRows > 1 Then
For j = i + 1 To i + mergedRows - 1
Dim L1 As Integer
Dim L2 As Integer
L1 = Len(Range("H" & i))
L2 = Len(Range("H" & j))
If Range("H" & i).Font.Strikethrough = True Then
If InStr(Range("H" & j), "Release") > 0 Then
Range("H" & j).Select
Range("H" & j).Activate
Call Clean_Formats
Range("H" & i).Value = Range("H" & i).Value & Chr(10) & Range("H" & j).Value
Dim L5 As Integer
L5 = Len(Range("H" & i))
Range("H" & i).Activate
With ActiveCell.Characters(Start:=L5 - L2 + 1, length:=L2).Font
.Strikethrough = False
End With
ElseIf Range("H" & j).Font.Strikethrough = True Then
Range("H" & j).Select
Range("H" & j).Activate
Call Clean_Formats
Range("H" & i).Value = Range("H" & i).Value & Chr(10) & Range("H" & j).Value
Dim L3 As Integer
L3 = Len(Range("H" & i))
Range("H" & i).Activate
With ActiveCell.Characters(Start:=L3 - L2 + 1, length:=L2).Font
.Strikethrough = True
End With
ElseIf Range("H" & j).Font.Strikethrough = False And L2 > 2 Then
Range("H" & i).Value = Range("H" & i).Value & Chr(10) & Range("H" & j).Value
Dim L4 As Integer
L4 = Len(Range("H" & i))
Range("H" & i).Activate
With ActiveCell.Characters(Start:=L4 - L2 + 1, length:=L2).Font
.Strikethrough = False
End With
ElseIf Range("H" & j).Font.Strikethrough = False And L2 < 2 Then
Range("H" & i).Value = Range("H" & i).Value
End If
ElseIf Range("H" & i).Font.Strikethrough = False Then
If InStr(Range("H" & i), "Release") > 0 Then
Range("H" & i).Select
Range("H" & i).Activate
Call Clean_underline
If InStr(Range("H" & j), "Release") > 0 Then
Range("H" & j).Select
Range("H" & j).Activate
Call Clean_Formats
Range("H" & i).Value = Range("H" & i).Value & Chr(10) & Range("H" & j).Value
Dim L8 As Integer
L8 = Len(Range("H" & i))
Range("H" & i).Activate
With ActiveCell.Characters(Start:=L8 - L2 + 1, length:=L2).Font
.Strikethrough = False
End With
ElseIf Range("H" & j).Font.Strikethrough = True Then
Range("H" & j).Select
Range("H" & j).Activate
Call Clean_Formats
Range("H" & i).Value = Range("H" & i).Value & Chr(10) & Range("H" & j).Value
Dim L6 As Integer
L6 = Len(Range("H" & i))
Range("H" & i).Activate
With ActiveCell.Characters(Start:=L6 - L2 + 1, length:=L2).Font
.Strikethrough = True
End With
ElseIf Range("H" & j).Font.Strikethrough = False And L2 > 2 Then
Range("H" & i).Value = Range("H" & i).Value & Chr(10) & Range("H" & j).Value
Dim L7 As Integer
L7 = Len(Range("H" & i))
Range("H" & i).Activate
With ActiveCell.Characters(Start:=L7 - L2 + 1, length:=L2).Font
.Strikethrough = False
End With
ElseIf Range("H" & j).Font.Strikethrough = False And L2 < 2 Then
Range("H" & i).Value = Range("H" & i).Value
End If
End If
Else
If InStr(Range("H" & j), "Release") > 0 Then
Range("H" & j).Select
Range("H" & j).Activate
Call Clean_Formats
Range("H" & i).Value = Range("H" & i).Value & Chr(10) & Range("H" & j).Value
Dim L11 As Integer
L11 = Len(Range("H" & i))
Range("H" & i).Activate
With ActiveCell.Characters(Start:=L11 - L2 + 1, length:=L2).Font
.Strikethrough = False
End With
ElseIf Range("H" & j).Font.Strikethrough = True Then
Range("H" & j).Select
Range("H" & j).Activate
Call Clean_Formats
Range("H" & i).Value = Range("H" & i).Value & Chr(10) & Range("H" & j).Value
Dim L9 As Integer
L9 = Len(Range("H" & i))
Range("H" & i).Activate
With ActiveCell.Characters(Start:=L9 - L2 + 1, length:=L2).Font
.Strikethrough = True
End With
ElseIf Range("H" & j).Font.Strikethrough = False And L2 > 2 Then
Range("H" & i).Value = Range("H" & i).Value & Chr(10) & Range("H" & j).Value
Dim L10 As Integer
L10 = Len(Range("H" & i))
Range("H" & i).Activate
With ActiveCell.Characters(Start:=L10 - L2 + 1, length:=L2).Font
.Strikethrough = False
End With
ElseIf Range("H" & j).Font.Strikethrough = False And L2 < 2 Then
Range("H" & i).Value = Range("H" & i).Value
End If
End If
Next j
Range("A" & i).UnMerge
End If
Next i
Range("A1").Select
End Sub
Sub Clean_Formats()
Dim rng As Range
Set rng = Selection
rng.Activate
With rng.Font
.FontStyle = "Regular"
.Strikethrough = False
.Superscript = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
End Sub
Sub Clean_underline()
Dim rng As Range
Set rng = Selection
rng.Activate
With rng.Font
.Underline = xlUnderlineStyleNone
End With
End Sub
f01 f02
2 <u>Unexpected low load</u>
P-23066667:<s> Availability</s>
3 Unexpected low traffic
P-23066632: Availability
4 other
Yes, that is true.
If play with html ,tags u and s are available to render underline and strikethrough.
select f01,f02 from unmerge_cells limit 5;
create temp table aa as
select fillna(f01) f01,f02 from unmerge_cells;
drop table if exists split_to_multiple;
create table split_to_multiple as
select f01,group_concat(f02,'<br>') f02 from aa group by f01;
select * from split_to_multiple;