How to apply auto fit for the merged columns [Excel]

[Shagoul_Hameed]

Hi All,

I’ve a requirement to apply auto fit for the merged columns and the text should be visible to read.
I’ve multiple excel files with different columns are merged.

Robot should read the excel file and find the merged columns and apply auto fit.

For example, one excel file D1 to H1 was merged i want to apply auto fit for the merged columns.
Example2: 2nd excel file C200 to G200 was merged

Can someone please help me is there any way to find that merged column and apply autofit.
TEST1.xlsx (9.0 KB)

Shagoul

[muhammedyuzuak]

Hi @Shagoul_Hameed,

Have you had a chance to check this link?

BalaReva.Excel.Activities

Hi Friends, I have included some new activities that merge and unmerge the cells Name Space : [image] Merge Cells - Merge the cells inside the excel file. Properties : [image] Sample File : MergeCells.zip (24.9 KB) UnMerge Cells- Unmerge the cells inside the excel file. Properties: [image] Sample : UnMergeCells.zip (24.8 KB) Let me know if you have any errors. I would be happy to get more suggestions Regards Balamurugan.S

Regards,
MY

[Shagoul_Hameed]

@Shagoul_Hameed

auto fit for the merged columns

Hi MY,

Thank you for the response, I’ve read this post this for to merge & unmerge the cells.

In my case the excel file already merged with few columns as I mentioned above.

I want only apply the “auto fit for the merged columns”.

Shagoul

[Shagoul_Hameed]

Hi All,

I found a solution working fine.

Am sharing the script which will help if anyone wants to find a merged cell in the excel file and apply to autofit.

Sub FindMergedCells()
 
' Declare sheet you want to look for merged cells on - in the example it's sheet 1
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Sheets(1)
  Dim rng As Range
    Dim rngStart As Range
    Dim rngEnd As Range
Dim tHeight As Integer
Dim iPtr As Integer
Dim oldWidth As Double
Dim oldZZWidth As Double
Dim newWidth As Double
Dim newHeight As Double
Dim oRange As Range


' Add sheet for output
Dim output As Worksheet
Set output = Sheets.Add(after:=Sheets(1))
 
' Initialize row counter for output
orow = 0
 
' Header on output sheet

 
' Check all the cells in the worksheet's used range
For Each cell In sheet.UsedRange
 
    ' If they're merged -

        If cell.MergeCells Then
            orow = orow + 1
            Set cell = cell.MergeArea
            Set rngStart = cell.Cells(1, 1)
            Set rngEnd = cell.Cells(cell.Rows.Count, cell.Columns.Count)

            'MsgBox "First Cell " & rngStart.Address & vbNewLine & "Last Cell " & rngEnd.Address
            'output.Cells(orow, 1) = "" & Replace(rngStart.Address, "$", "") & ":" & Replace(rngEnd.Address, "$", "")
            Set oRange = Range("" & Replace(rngStart.Address, "$", "") & ":" & Replace(rngEnd.Address, "$", ""))
            
              With sheet
                  oldWidth = 0
                  For iPtr = 1 To oRange.Columns.Count
                    oldWidth = oldWidth + .Cells(1, oRange.Column + iPtr - 1).ColumnWidth
                  Next iPtr
                  'oldWidth = .Cells(1, oRange.Column).ColumnWidth + .Cells(1, oRange.Column + 1).ColumnWidth
                  oRange.MergeCells = False
                  newWidth = Len(.Cells(oRange.Row, oRange.Column).Value)
                  oldZZWidth = .Range("ZZ1").ColumnWidth
                  .Range("ZZ1") = Left(.Cells(oRange.Row, oRange.Column).Value, newWidth)
                  .Range("ZZ1").WrapText = True
                  .Columns("ZZ").ColumnWidth = oldWidth
                  .Rows("1").EntireRow.AutoFit
                  newHeight = .Rows("1").RowHeight / oRange.Rows.Count
                  .Rows(CStr(oRange.Row) & ":" & CStr(oRange.Row + oRange.Rows.Count - 1)).RowHeight = newHeight
                  oRange.MergeCells = True
                  oRange.WrapText = True
                  .Range("ZZ1").ClearContents
                  .Range("ZZ1").ColumnWidth = oldZZWidth
                End With
            Else

            'MsgBox "Not merged area"

            End If
Next cell
 
End Sub