[Solved] Merge/allign cells in Columns macro

[marcobernardo]

Hi everyone,

How can I merge automatically cells that are in different columns to be in the right Columns?

Regards,
Marco

[B Marcelly]

What do you want to achieve ?
As an example, write in sheet2 of the document the result you want.

[Zizi64]

The data in your example file seems as imported textual format 'Time values' from a text (TSV) file, with multiple separator (delimiter) characters. (TABs for example.) You can merge delimiters when you import the data.

[marcobernardo]

What do you want to achieve ?
As an example, write in sheet2 of the document the result you want.

HI Bernard,
Here is the final result I like to achieve if possible.

The data in your example file seems as imported textual format 'Time values' from a text (TSV) file, with multiple separator (delimiter) characters. (TABs for example.) You can merge delimiters when you import the data.

You're right, but the file as more data, and if I use delimiters it will put in the same row and cell other type of data

Thank you so much for help me out.

[B Marcelly]

Here is a solution.

Align_cells_AtLeft.ods

Example with code

(11.53 KiB) Downloaded 206 times

Somewhere in columns D to L, it is expected to find 4 data in succession.
Empty lines are skipped.
Adapt to your needs.

Code: Select all

Option Explicit

Sub AlignToColumnLeft
Dim sh As Object, zone As Object, dataRow As Variant
Dim y As Long, x1 As Long, x2 As Long
Const minCol = 3, maxCol = 11 ' columns D to L contain data
Const nbrOfValues = 4

sh = ThisComponent.Sheets.getByName("Sheet1")

for y = 0 to 100 ' from row 1 to row 101 (example)
  zone = sh.getCellRangeByPosition(minCol, y, maxCol, y)
  dataRow = zone.DataArray
  dataRow = dataRow(0) ' get the list of data
  x1 = 0
  Do While Len(dataRow(x1)) = 0
    x1 = x1 +1
    if x1 > UBound(dataRow)  then exit do ' no data in this line
  Loop
  if (x1 > 0) and (x1 <= UBound(dataRow))  then
    for x2 = 0 to nbrOfValues -1 ' move data to left
      dataRow(x2) = dataRow(x2 +x1)
    next
    for x2 = nbrOfValues to UBound(dataRow) ' clear the rest
      dataRow(x2) = "" 
    next
    zone.dataArray = Array(dataRow)
  end if
next
End Sub

[marcobernardo]

Here is a solution.

Align_cells_AtLeft.ods

Somewhere in columns D to L, it is expected to find 4 data in succession.
Empty lines are skipped.
Adapt to your needs.

Code: Select all

Option Explicit

Sub AlignToColumnLeft
Dim sh As Object, zone As Object, dataRow As Variant
Dim y As Long, x1 As Long, x2 As Long
Const minCol = 3, maxCol = 11 ' columns D to L contain data
Const nbrOfValues = 4

sh = ThisComponent.Sheets.getByName("Sheet1")

for y = 0 to 100 ' from row 1 to row 101 (example)
  zone = sh.getCellRangeByPosition(minCol, y, maxCol, y)
  dataRow = zone.DataArray
  dataRow = dataRow(0) ' get the list of data
  x1 = 0
  Do While Len(dataRow(x1)) = 0
    x1 = x1 +1
    if x1 > UBound(dataRow)  then exit do ' no data in this line
  Loop
  if (x1 > 0) and (x1 <= UBound(dataRow))  then
    for x2 = 0 to nbrOfValues -1 ' move data to left
      dataRow(x2) = dataRow(x2 +x1)
    next
    for x2 = nbrOfValues to UBound(dataRow) ' clear the rest
      dataRow(x2) = "" 
    next
    zone.dataArray = Array(dataRow)
  end if
next
End Sub

It worked great Bernard!!! thank you so much

Now I need to adapt as you said to my needs, the columns should be from B to J in the macro I'm trying to do.

Regards,
Marco

[karolus]

Hallo

half the lines of code, easier to understand … but python

Code: Select all

def normalize_data():
    
    doc = XSCRIPTCONTEXT.getDocument()
    sheet = doc.CurrentController.ActiveSheet
    cursor = sheet.createCursor()
    cursor.gotoStartOfUsedArea(0)
    cursor.gotoEndOfUsedArea(1)
    data = cursor.FormulaArray
    size = len(data[0])
    out = []

    for row in data:
        row = [entry for entry in row if entry]
        row.extend( [''] * ( size-len(row)) )
        out.append(tuple(row))

    cursor.setFormulaArray( tuple(out))

[MrProgrammer]

Hi, and welcome to the forum.

Here is the final result I like to achieve if possible.

Adapt to your needs. {30-line macro}

half the lines of code, easier to understand … but python ;-) {17-line macro}

I've used three short formulas (shown for cell D1 on three new sheets), and no evil macro. If you are not a programmer, it may be easier to understand and adapt a formula solution than a macro solution. You'll need to understand the fundamental spreadsheet concept of relative vs. absolute addressing, explained in the tutorial below.
StepA: =ISTEXT($Data.D1)
StepB: =SUM(C1;MATCH(TRUE();OFFSET($StepA.$A1;0;C1;1;12);0))
Result: =IF(ISNUMBER($StepB.D1);OFFSET($Data.$A1;0;$StepB.D1-1);"")

201603231212.ods

(15.15 KiB) Downloaded 211 times

Read about ISTEXT, SUM, MATCH, TRUE, OFFSET, IF, and ISNUMBER in the Help, in this forum, or in the Wiki. The task is easier if one can assume that the four non-empty cells in a row are adjacent. I supposed they were not.
[Tutorial] Ten concepts that every Calc user should know

If this solved your problem please go to your first post use the Edit button and add [Solved] to the start of the title. You can select the green checkmark icon at the same time.

[marcobernardo]

Hi, and welcome to the forum.

Here is the final result I like to achieve if possible.

Adapt to your needs. {30-line macro}

half the lines of code, easier to understand … but python {17-line macro}

Three short formulas (shown for cell D1 on three new sheets), no evil macro. If you are not a programmer, it may be easier to understand and adapt a formula solution than a macro solution. You'll need to understand the fundamental spreadsheet concept of relative vs. absolute addressing, explained in the tutorial below.
StepA: =ISTEXT($Data.D1)
StepB: =SUM(C1;MATCH(TRUE();OFFSET($StepA.$A1;0;C1;1;12);0))
Result: =IF(ISNUMBER($StepB.D1);OFFSET($Data.$A1;0;$StepB.D1-1);"")

201603231212.ods

Read about ISTEXT, SUM, MATCH, TRUE, OFFSET, IF, and ISNUMBER in the Help, in this forum, or in the Wiki. The task is easier if one can assume that the four non-empty cells in a row are adjacent. I supposed they were not.
[Tutorial] Ten concepts that every Calc user should know

If this solved your problem please go to your first post use the Edit button and add [Solved] to the start of the title. You can select the green checkmark icon at the same time.

Thank you.

I've just adapted the Bernard code to my needs it worked flawlessly. Thanks again Bernardo

Karolus - I will try that python code too in a few hours. Thank you

This will do what I need and delete some columns that I want. There's another step to clean this sheet, I can't even try to explain If I want I need to think and read. And I can bet that I will need help for sure!

My needs is clean a sheet to keep only what I need to see.

Code: Select all

REM  *****  BASIC  *****
  Sub Main
 AlignToColumnLeft(step1)
 S_delete_empty_rows(step2)
  End Sub
  
sub AlignToColumnLeft(step1) rem--- thanks to Bernard Marcelly 
dim document   as object
dim dispatcher as object
Dim sh As Object, zone As Object, dataRow As Variant
Dim y As Long, x1 As Long, x2 As Long
Const minCol = 16, maxCol = 24 ' columns D to L contain data
Const nbrOfValues = 4

sh = ThisComponent.Sheets.getByName("Sheet1_2")

for y = 0 to 900 ' from row 1 to row 101 (example)
  zone = sh.getCellRangeByPosition(minCol, y, maxCol, y)
  dataRow = zone.DataArray
  dataRow = dataRow(0) ' get the list of data
  x1 = 0
  Do While Len(dataRow(x1)) = 0
    x1 = x1 +1
    if x1 > UBound(dataRow)  then exit do ' no data in this line
  Loop
  if (x1 > 0) and (x1 <= UBound(dataRow))  then
    for x2 = 0 to nbrOfValues -1 ' move data to left
      dataRow(x2) = dataRow(x2 +x1)
    next
    for x2 = nbrOfValues to UBound(dataRow) ' clear the rest
      dataRow(x2) = "" 
    next
    zone.dataArray = Array(dataRow)
  end if
next

document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$A$1:$E$1"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:DeleteColumns", "", 0, Array())
rem ----------------------------------------------------------------------
dim args2(0) as new com.sun.star.beans.PropertyValue
args2(0).Name = "ToPoint"
args2(0).Value = "$B$1:$M$1"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args2())
rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:DeleteColumns", "", 0, Array())

rem ----------------------------------------------------------------------
dim args3(0) as new com.sun.star.beans.PropertyValue
args3(0).Name = "ToPoint"
args3(0).Value = "$D$1:$Z$1"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args3())
rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:DeleteColumns", "", 0, Array())

rem ----------------------------------------------------------------------
end sub

Sub S_delete_empty_rows(step2)  rem--- thanks to F3K Total
    dim bEmpty as boolean
    dim nCounter as integer
    oSheet = thiscomponent.sheets.getbyname("Sheet1_2")
    oCursor = oSheet.createcursor
    oCursor.gotoendofusedarea(false)
    nEndColumn = oCursor.rangeaddress.EndColumn
    nEndrow = oCursor.rangeaddress.Endrow
    nCounter = 0
    for i = nEndrow to 0 step - 1
        bEmpty = true
        for k = 0 to nEndColumn
           ocell = osheet.getcellbyposition(k,i)
           if oCell.Type <> com.sun.star.table.CellContentType.EMPTY then 
           bEmpty = false
           exit for
           end if
        next k
        if bEmpty then 
            osheet.rows.removeByIndex(i,1)
            nCounter = ncounter + 1
        end if
    next i
    msgbox (nCounter & " rows deleted",64,"Success")
 end sub

[marcobernardo]

Here is a https://youtu.be/5FApxj7by2o what I could achieve with your help.

Thank you all
Regards,
Marco