'Transcoding' Excel Macros to Calc Add-ins - just common question

English
, ,
#1

Hi Folks!
Maybe my question sounds like a request but is not, just I wish to know your opinion…
During my life I have made a lot of (around of 36 MB) Excel macros, Add-ins, some of them are functions and features very practical but absent in Excel.
Now I am going to convert them to Calc, but since now I am a bit old, the learning is not so fast as it was in the past. :frowning:

So, if I share a few VB macro - with descriptions, is anyone interested to convert them to an add-in, or somewhat? I don’t want to have someone else do it, but I think that is faster than waiting for me while am learning LO BASIC /C++.
Some highlights:
-Data mass conversions:
-for example some SAP reports contains numbers with delimiters that differs from the system defaults, like a dot for decimals, and the system uses this for thousand delimiter, so the number one is handled as thousand, and vice versa.
-Date stored as string in different formats to date
-Multiply by 10 /100 /100
-Links as string to hyperlinks
-E-mail addresses to mailto: links
-Numbers to strings format (aka EAN code/telephone numbers)
and more…

Record (rows) functions
-Deleting empty rows (some SAP reports have empty rows between the rows containing the data)
-Handling redundant rows - with different scopes, options, and operations (sort by, or not) scope: active column, active column+ the next column and more, operation : delete the second occurrence / colorize them - few colors as options-yellow, blue, red, green… -+ option: do it for both (the first and second occurrence) -or just for the second.

What do you think? It wouldn’t be good to be in Calc such things as above?

#2

If you publish it one by one, I will try help you to migrate, but, only in Python, Basic is very boring.

#3

Thank you for offering.
here is one, if is not too complicated. The messages can be modified, these are Excel related, and translated from Hungarian in a hurry…

Sub redundantdata()
'Delete or mark rows with redundant data...
'This macro checks one or two or three cells row by row to determine if the value of
'those cells are the same as the cells in next row. Only the next row is examined,
'the macro does not performing a search to find a cell with the same value in another rows.

  Dim record_nr As Long 'last row containing data
  Dim col_nr As Integer 'last column containing data
  Dim Ask As Boolean 'common variable to determine a status
  Dim Scope As String 'area to examine
  Dim Action As String 'what to do
  Dim Do_sort As String 'Sort by active column for "better" result or not
  Dim Target As Boolean 'If False colorize only the second occurrence, if True colorize the first ad second...
  Dim C_target As Boolean 'If False colorize the background, if True the characters

'Show attention message with Yes/No buttons
'The result of pressed button is stored in the "Answer" variable:
Message = "Attention! You started to mark or delete the " + Chr(10) + _
       "rows with redundant data! This operation may" + Chr(10) + _
       "colorize or delete some rows from this sheet!" + Chr(10) + Chr(10) + _
       "                 Really do this?"
Style = vbYesNo + vbExclamation + vbDefaultButton2
Title = "Delete/colorize redundant data..."
Answer = MsgBox(Message, Style, Title)
'The Answer:
If Answer = vbYes Then  ' Yes button pressed
GoTo yes
End If
If Answer = vbNo Then 'No button pressed
Exit sub 'close the macro
End If
yes:
'The macro displays a dialog with three tabs: Action; Scope; Sort
'AFAIK LibreOffice does not supports tabs on dialog, so the dialog may be redesigned
'Sets the defaults for Redundant_dialog controls
Redundant_dialog.OptionButton1.Value = True 'colorize to yellow 
Redundant_dialog.OptionButton2.Value = False 'colorize the borders to red
Redundant_dialog.OptionButton3.Value = False 'colorize to blue
Redundant_dialog.OptionButton4.Value = False 'delete the row
Redundant_dialog.OptionButton5.Value = True 'scope active column
Redundant_dialog.OptionButton6.Value = False 'scope first and second column
Redundant_dialog.OptionButton7.Value = False 'scope first, second and third column
Redundant_dialog.OptionButton8.Value = False 'scope entire row
Redundant_dialog.OptionButton9.Value = False 'scope active column and the active + 2 column to right
Redundant_dialog.OptionButton10.Value = True 'do no sort
Redundant_dialog.OptionButton11.Value = False 'sort by scope /if the scope is the entire row, then sort by columns A;B;C
Redundant_dialog.CeckBox1.Value=False' if True then colorizes the first and second occurrence, if false then only the second
Redundant_dialog.CeckBox2.Value=False' if True then colorizes the font, not the interior / borders of cells

Ask = False 'now this is used to determine the button pressed on dialog (OK/Cancel), the dialog sets to True if OK is pressed
'show Redundant_dialog UserForm:

Redundant_dialog.Show

'If OK button was not pressed
If Ask = False Then exit Sub
Ask = False
Target=False
C_target=False

'In case of error - for example in case of merged cells the sort causes error in Excel
On Error GoTo errhandle

Start_:
'************************************************************
'in the original macro these settings are performed by dialog
If Redundant_dialog.OptionButton1.Value = True Then Action = "to_yellow"
If Redundant_dialog.OptionButton2.Value = True Then Action = "to_red"
If Redundant_dialog.OptionButton3.Value = True Then Action = "to_blue"
If Redundant_dialog.OptionButton4.Value = True Then Action = "to_delete"
If Redundant_dialog.OptionButton5.Value = True Then Scope = "act"
If Redundant_dialog.OptionButton6.Value = True Then Scope = "12c"
If Redundant_dialog.OptionButton7.Value = True Then Scope = "123c"
If Redundant_dialog.OptionButton8.Value = True Then Scope = "e_row"
If Redundant_dialog.OptionButton9.Value = True Then Scope = "act+2"
If Redundant_dialog.OptionButton10.Value = True Then Do_sort = "nosort"
If Redundant_dialog.OptionButton11.Value = True Then Do_sort = "sort"
If Redundant_dialog.Redundant_dialog.CeckBox1.Value = True Then Target=True 'if True colorize the first and second occurrence 
If Redundant_dialog.Redundant_dialog.CeckBox1.Value = True Then C_target=True 'if True colorize the font 
'******************************************************


'determine the last row and column
'and check if the active cell is offside:
  record_nr= ActiveCell.SpecialCells(xlLastCell).Row
  col_nr = ActiveCell.SpecialCells(xlLastCell).Column
  act_column = ActiveCell.Column
  If act_column > col_nr Then GoTo offside
  
Select Case Do_sort
'If sort does not required then go  to "tov1"
  Case Is = "nosort"
  GoTo tov1
  Case Is = "sort"
'sort as desired....


  If Scope = "act" Then
  'sort by active column...
  Range(Cells(1, 1), Cells(record_nr, col_nr)).Select
      Selection.Sort Key1:=Cells(2, act_column), Order1:=xlAscending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  End If
  
  If Scope = "12c" Then
  'sort by first and second column
  Range(Cells(1, 1), Cells(record_nr, ActiveCell.SpecialCells(xlLastCell).Column)).Select
      Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
      , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
      , Orientation:=xlTopToBottom
  End If
  
  If Scope = "123c" Then
  'Sort by first, second and third column...
  Range(Cells(1, 1), Cells(record_nr, ActiveCell.SpecialCells(xlLastCell).Column)).Select
      Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
      , Order2:=xlAscending, Key3:=Range("C2"), Order3:=xlAscending, Header:= _
      xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  End If
  
  If Scope = "e_row" Then
  'Sort by first, second and third column...
  Range(Cells(1, 1), Cells(record_nr, ActiveCell.SpecialCells(xlLastCell).Column)).Select
      Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
      , Order2:=xlAscending, Key3:=Range("C2"), Order3:=xlAscending, Header:= _
      xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  End If
  
  If Scope = "act+2" Then
  If act_column > 254 Then GoTo too_right
  If act_column = col_nr Then GoTo c_error
      Range(Cells(1, 1), Cells(record_nr, ActiveCell.SpecialCells(xlLastCell).Column)).Select
      Selection.Sort Key1:=Cells(2, ActiveCell.Column), Order1:=xlAscending, _
      Key2:=Cells(2, ActiveCell.Column + 2), Order2:=xlAscending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  End If
 
End Select
tov1:

On Error GoTo 0 'in case of error Excel will handle the error/ goto errhandle disabled

Ask = False
'Check the items.
For i = 2 To record_nr
If Scope = "act" Then
  c_cell = Cells(i, act_column)
  Cells(i, act_column).Select
  c_value = Cells(i, act_column).Value
  next_value = Cells(i + 1, act_column).Value
End If
If Scope = "12c" Then
  If act_column = 256 Then GoTo too_right
  c_cell = Cells(i, 1)
  Cells(i, 1).Select
  c_value = Format(Cells(i, 1).Value()) & Format(Cells(i, 2).Value())
  next_value = Format(Cells(i + 1, 1).Value()) & Format(Cells(i + 1, 2).Value())
End If
If Scope = "123c" Then
  If act_column > 254 Then GoTo too_right
  c_cell = Cells(i, 1)
  Cells(i, 1).Select
  c_value = Format(Cells(i, 1).Value()) & Format(Cells(i, 2).Value()) & Format(Cells(i, 3).Value())
  next_value = Format(Cells(i + 1, 1).Value()) & Format(Cells(i + 1, 2).Value()) & Format(Cells(i + 1, 3).Value())
End If
If Scope = "e_row" Then
  c_cell = Cells(i, 1)
  Cells(i, 1).Select
  c_value = ""
  next_value = ""
  For sor = 1 To col_nr
  c_value = c_value & Format(Cells(i, sor).Value())
  next_value = next_value & Format(Cells(i + 1, sor).Value())
  If Len(c_value) > 156000 Then GoTo too_long  'strings longer than 156000 chars causes extreme slow performance in Excel
  Next sor
End If
If Scope = "act+2" Then
  If act_column > 254 Then GoTo too_right
  c_cell = Cells(i, act_column)
  Cells(i, act_column).Select
  c_value = Cells(i, act_column).Value & Format((Cells(i, act_column).Offset(0, 2).Value))
  next_value = Cells(i + 1, act_column).Value & Format((Cells(i + 1, act_column).Offset(0, 2).Value))
End If
  If Selection.MergeCells Then Ask = True
     
'Check the redundancy
  Select Case c_value
  Case Is = next_value
 
          Range(Cells(i, 1), Cells(i, col_nr)).Select

          If Action = "to_yellow" Then
              If C_target=False Then Selection.Interior.ColorIndex = 6
              If C_target=True Then Selection.Font.ColorIndex = 6
              If Target=True Then
              If C_target=False Then Range(Cells(i+1, 1), Cells(i+1, col_nr)).Interior.ColorIndex = 6
              If C_target=True Then Range(Cells(i+1, 1), Cells(i+1, col_nr))..Font.ColorIndex = 6
              End if 'Target=True
          End if       
          If Action = "to_blue" Then 
              If C_target=False Then Selection.Interior.ColorIndex = 5
              If C_target=True Then Selection.Font.ColorIndex = 5
              If Target=True Then
              If C_target=False Then Range(Cells(i+1, 1), Cells(i+1, col_nr)).Interior.ColorIndex = 5
              If C_target=True Then Range(Cells(i+1, 1), Cells(i+1, col_nr))..Font.ColorIndex = 5
              End if 'Target=True
          End If

          If Action = "to_red" Then
             If C_target=False  
             With Selection.Borders(xlEdgeLeft)
              .LineStyle = xlContinuous
              .Weight = xlThick
              .ColorIndex = 3
             End With
             With Selection.Borders(xlEdgeTop)
              .LineStyle = xlContinuous
              .Weight = xlThick
              .ColorIndex = 3
             End With
             With Selection.Borders(xlEdgeBottom)
              .LineStyle = xlContinuous
              .Weight = xlThick
              .ColorIndex = 3
             End With
             With Selection.Borders(xlEdgeRight)
              .LineStyle = xlContinuous
              .Weight = xlThick
              .ColorIndex = 3
             End With
          End If 'C_target=False
          If C_target=True Then Selection.Font.ColorIndex = 3

          If Target=True Then
             If C_target=False  
             With Range(Cells(i+1, 1), Cells(i+1, col_nr)).Borders(xlEdgeLeft)
              .LineStyle = xlContinuous
              .Weight = xlThick
              .ColorIndex = 3
             End With
             With Range(Cells(i+1, 1), Cells(i+1, col_nr)).Borders(xlEdgeTop)
              .LineStyle = xlContinuous
              .Weight = xlThick
              .ColorIndex = 3
             End With
             With Range(Cells(i+1, 1), Cells(i+1, col_nr)).Borders(xlEdgeBottom)
              .LineStyle = xlContinuous
              .Weight = xlThick
              .ColorIndex = 3
             End With
             With Range(Cells(i+1, 1), Cells(i+1, col_nr)).Borders(xlEdgeRight)
              .LineStyle = xlContinuous
              .Weight = xlThick
              .ColorIndex = 3
             End With
          End If 'C_target=False
          If C_target=True Then Range(Cells(i+1, 1), Cells(i+1, col_nr)).Font.ColorIndex = 3
          End If 'Target=True
          End if 'Action = "to_red"

          If Action = "to_delete" Then
              If Ask = True Then GoTo merged_cells
          Rows(i).Delete
          i = i - 1
          If Target=True Then Rows(i).Delete
          End If

          next_value = -1
 
      If IsEmpty(c_cell) Then
          i = record_nr
      End If

  Case Else
  End Select
Next i
MsgBox "Done", 64, Title
If Ask = True Then GoTo merged_cells
GoTo doubleout

'some error messages:
c_error:
MsgBox " The selected operation can't performed," + Chr(10) + _
     "because there is more cells after the first cell" + Chr(10) + _
     "in data range selected for examination!" + Chr(10) + Chr(10) + _
     "(The table is too wide or the selected cell is too right!" + Chr(10) + _
     " ", vbCritical + vbOKOnly, Title
GoTo doubleout
too_long:
MsgBox " The selected operation can't performed," + Chr(10) + _
     "because the rows of the area selected (entire row) containing" + Chr(10) + _
     "to many(more than 156000) chars which causes extreme" + Chr(10) + _
     "slow performance. Please try different options...", vbCritical + vbOKOnly, Title
GoTo doubleout
merged_cells:
MsgBox "The selected operation can't performed" + Chr(10) + _
     "found merged cells, marking / deleting them may be incorrect.", 64, Title
GoTo doubleout
too_right:
MsgBox " The table is too wide and the range to be evaluated " + Chr(10) + _
     "is outside the last cells in the rows!" + Chr(10) _
     , vbCritical + vbOKOnly, Title
GoTo doubleout
offside:
MsgBox " The active cell is out of the data area." + Chr(10) + _
     "The operation can't be performed!" + Chr(10) _
     , vbCritical + vbOKOnly, Title
GoTo doubleout
errhandle:
'tipical error...
If Err.Number = 1004 Then
'If there are merged cells in area to sort in Excel causes this error... 
MsgBox "It is not possible to sort the table because "+ Chr (10) + _
      "there are merged cells in the data area! !" + Chr(10) _
     , vbCritical + vbOKOnly, Title
GoTo doubleout
End If
If Err.Number = 91 Then
MsgBox "Error, no workbook appears to be open!" + Chr(10) + _
     "" + Chr(10) _
     , vbCritical + vbOKOnly, Title
GoTo doubleout
End If
    
doubleout:
End Sub

edit: corrected a bug code “If Target=True Then Rows(i).Delete” is correct If “Target=True Then Rows(i+1).Delete” was wrong

#4

This can and should be done without any macro code if you are able to connect a Base document to the SAP database. Creating a report (office document) from a report is a no go. Instead of SAP reports you should link to the raw data. Then you can link spreadsheet ranges to raw data and format them any way you want.
I know nothing about SAP. I would expect that they offer some ODBC or JDBC driver for their data sources.

#5

Yes, You are right but as you wrote, such query methods are not the only thing. There are also other reporting tools with “customized” / formatted outputs and a lot of people uses them.
But the macro above is for general use, not for SAP reports. For example to search for duplicate data in any database to fix it or to check items which must be “paired” so they should be included twice in database or for any else reasons.
What I mentioned above about SAP is another related macro, which is also a multi-use case, fixing SAP reports is just a thing among others.

#6

You can connect as many databases as needed (one database per database document, though). This is by far easier than writing a complete macros suite with dialogs.
Detecting and editing duplicates by means of forms is trivial.
With the outlined macro (which references some kind of dialog or form) you are all alone.

#7

I found a simple example database document (*.odb) demonstrating how I would deal with duplicate records. This is not a connection to some external database (SAP/ADO/MSSQL). The demo database is embedded in the database document.
DummyPersons.odb (19.2 KB)

It has a table of persons with enforced uniqueness of forename, surname and birth date. When you open the embedded input form, you see a table of Soundex strings with their occurrances. 2 different names share the same Soundex string when they sound similar regardless of spelling.
You select an entry on the left and get an editable row set on the right side where you can edit or delete duplicates with similar names. This basic functionality does not require a single line of macro code.

#8

You can imagine that is no problem formulating a SELECT for me.
The Add-in which contains that macro is used by about 40 persons, and that macro was first used under Excel6 (yes, 16 bit, WFW3.11 I have seen my comments from that time in code when I translated it.) And it is still used today. And believe me, for those persons a few mouse clicks are easier than formulating an SQL. And it is not an Access macro. It runs under Excel (colorful smelling reports, you know …). BTW the macro runs on any opened workbook regardless of the database structure (that must be specified in SQL)
But I don’t insist on rewriting the macro, I just asked for information.

Impressum (Legal Info) | Datenschutzerklärung (Privacy Policy)   Content on this site is licensed under a Creative Commons Attribution Share Alike 3.0 license.