Librestrookjes.ods (796.9 KB)
I would like to have a macro in the attached file. The intention is that in every row in column 4, characters from CHR$(64) to CHR$(90) are searched for. When a character is found, the data from columns 3, 4, 11, and 23 of that row should be placed in the sheet named after that character. The intention is that every time the macro is executed, it starts with a clean slate, so the sheets from @ to Z must be completely cleared first each time.
Hello Gilberto,
Hi Gilberto,
The spreadsheet has 23 columns. Maybe you didn’t notice that there are several columns hidden between columns 11 and 21?
Can you help me with my question?
Greetings,
Frits Hendrikx
on this very forum, probably a dozens of frequent contributors could and would.
why aren’t they answering ?
probably cause they get tired of XY problem - Wikipedia and Reinventing the wheel - Wikipedia.
and there’s no clear easy reference to quickly explain why your request for a macro is such a XY problem.
in essence, see Data organization guide, where?
maybe you can expand a bit more your use case, to get some constructive feedback on how to avoid such a need for macro – typically Applying Filters.
on the ohter hand, nowadays, any AI would (almost) write you this macro.
This isn’t the only possible cause. For example, a delay in response could be caused by a blackout (can you imagine a situation where the power goes out for several days?)
Option Explicit
Sub VerdeelOpKarakter_Geoptimaliseerd()
Const MIN_CHAR = 64
Const MAX_CHAR = 90
Dim oSheets As Variant
Dim oSheet As Variant
Dim oCursor As Variant
Dim aRaw As Variant, aToPrint As Variant
Dim aIdx() As Long
Dim i As Long, j As Long, iChar As Integer
Dim sChar As String, sTest As String
oSheets = ThisComponent.getSheets()
oSheet = oSheets.getByName("Cat")
oCursor = oSheet.createCursor()
oCursor.gotoEndOfUsedArea(True)
Rem Copy data of used range to single big array
aRaw = oCursor.getDataArray()
j = UBound(aRaw) + 1
Rem Extract row numbers to dictionary
ReDim aIdx(MIN_CHAR To MAX_CHAR, 0 To j)
For i = LBound(aRaw) + 1 To UBound(aRaw)
sTest = Trim(aRaw(i)(3))
If Len(sTest) > 0 Then ' Skip empty cells
For iChar = MIN_CHAR To MAX_CHAR
sChar = Chr(iChar)
If InStr(sTest, sChar) Then
aIdx(iChar,0) = aIdx(iChar,0) + 1
aIdx(iChar,aIdx(iChar,0)) = i
If Len(sTest) < 2 Then Exit For
EndIf
Next iChar
EndIf
Next i
Rem And put data to sheets
For iChar = MIN_CHAR To MAX_CHAR
sChar = Chr(iChar)
If Not oSheets.hasByName(sChar) Then oShets.insertNewByName(sChar,255)
oSheet = oSheets.getByName(sChar)
oSheet.clearContents(1023)
ReDim aToPrint(0 To aIdx(iChar,0))
i = 0
aToPrint(i) = Array(aRaw(i)(2),aRaw(i)(3),aRaw(i)(10),aRaw(i)(22))
For j = 1 To aIdx(iChar,0)
i = aIdx(iChar,j)
aToPrint(j) = Array(aRaw(i)(2),aRaw(i)(3),aRaw(i)(10),aRaw(i)(22))
Next j
oSheet.getCellRangeByPosition(0,0,3,aIdx(iChar,0)).setDataArray(aToPrint)
Next iChar
Print "Done!"
End Sub
Hi Schiavinatto. The spreadsheet has 23 columns. Maybe you didn’t notice that there are several columns hidden between columns 11 and 21?