-
1 Attachment(s)
VBA Macro which creates new lines by codes
Hi, everyone!
I've got a task to bring an excel document to its normal appearance. The "Old" sheet has some codes separated by semicolons and dashes in column B. I need to have only 1 code in each line (as in the "New" sheet). That is, it is necessary that Excel automatically creates new lines with only one code, with just duplicating data from the other columns. Also, if a code is, for example, "101-104" in a cell, Excel is to create 4 lines with codes 101, 102, 103, 104 separately.
You can already see the green cells as an example.
The task is to provide a VBA macro, not just create a new sheet manually.
I really ask for your help!
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=SIDLFRkUEIo&lc=UgzTF5vvB67Zbfs9qvx4AaABAg
https://www.youtube.com/watch?v=v_1iqtOnUMg&lc=UgxLtKj969oiIu7zNb94AaABAg
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugxq4JHRza_zx3sz0fx4AaABAg
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugxq4JHRza_zx3sz0fx4AaABAg
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgzMCQUIQgrbec400jl4AaABAg
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugx12mI-a39T41NaZ8F4AaABAg.9iDQqIP56NV9iFD0AkeeJG
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=Ugxa2VYHMWJWXA6QI294AaABAg. 9irLgSdeU3r9itU7zdnWHw
https://www.youtube.com/watch?v=tPRv-ATUBe4&lc=UgzFkoI0n_BxwnwVMcZ4AaABAg
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9htG01cKBzX
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw6UrV69zpeKvLOeOV4AaABAg. 9ht16tzryC49htJ6TpIOXR
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwMKwGZpDjv7vi7pCx4AaABAg
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw6UrV69zpeKvLOeOV4AaABAg. 9ht16tzryC49htOKs4jh3M
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgxVW-am20rQ5GFuJ9F4AaABAg
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
-
1 Attachment(s)
Hello Alex,
Welcome to ExcelFox :)
I think something like this could be solved in VBA in many different ways. So many that it would probably take me personally a very long time to go through them all and decide which is the best. - I don’t have the time for all that, so I will do the first solution that comes into my head to get you started.
It’s unlikely that it would be the best or most efficient solution.
Here a quick summary of my thinking, and the solution which I am making up as I go along and writing the solution
I took a quick look here: https://excelfox.com/forum/showthrea...5531#post15531 , at some of your data in column C. It doesn’t look as though there are any unusual or “hidden” characters in it
"655" & ";" & " 661" & ";" & " 663" & ";" & " 665" & ";" & " 667" & ";" & " 6688" & ";" & " 670" & ";" & " 677" & ";" & " 678" & ";" & " 68860" & "-" & "68861" & ";" & " 68864" & ";" & " 68877" & ";" & " 6889" & ";" & " 689" & ";" & " 690" & ";" & " 810" & ";" & " 820"
In simple terms : It looks as though what you see is what you have.
I personally would usually use VBA array techniques whereby I capture all data into an internal array in memory that I cannot see, and access that with VBA coding , get all my results, then paste them out to the new worksheet in one go.
The main reason for that is that interacting with many cells in a worksheet can be very inefficient.
But in this case a lot of information is in a single cell in column C, and I also notice that we finally want in some columns the same value pasted out into many cells. So in your particular case, our interaction with the worksheet is minimised – I can sometimes take a lot of information in , in one go , and can sometimes paste out a lot of information in one go
General macro coding explanation
Rem 2
I have a main loop going down all your name cells =====
' 2b This deals with converting any numbers ranges written like 101-104
' 2c The modified data in simple number form for the column C list is produced in a 1 D array, arrOutTempC(). Excel recognises such an array as pseudo horizontal like in a row, so we transpose that to produce a pseudo like single column array, arrOutTempCT()
' 2d All the column data for a particular name is pasted out
I have not tested thoroughly, and there are likely other tweaks necessary to get finally exactly what you want, but it should get you started. At first glance it seems to do what you want - See here https://excelfox.com/forum/showthrea...ll=1#post15533
Alan
Code:
Option Explicit
Sub Alex1() ' https://excelfox.com/forum/showthread.php/2747-VBA-Macro-which-create-new-lines-by-codes
Rem 1 Worksheets info
Dim WsOld As Worksheet, WsNew As Worksheet
Set WsOld = ThisWorkbook.Worksheets("Old"): Set WsNew = ThisWorkbook.Worksheets("New")
Dim Lr As Long: Let Lr = WsOld.Range("A" & WsOld.Rows.Count & "").End(xlUp).Row ' https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files-or-single-Excel-File?p=11467&viewfull=1#post11467
Rem 2
Dim ACel As Range, TLeft As Long: Let TLeft = 2 ' This variable holds the position of the next section in the New worksheet
For Each ACel In WsOld.Range("A2:A" & Lr & "") ' main loop going down all name cells ======
Dim AName As String: Let AName = ACel.Value2
Dim CVal As String: Let CVal = ACel.Offset(0, 2).Value2 & ";" ' I need the extra ; or otherwise I might miss the last number range ( number range is something like 45-48 ) if there is one, because I look for the ; in order to determine where that number rang ends
' 2b modifying any 3-5 type data into like 3; 4; 5
Dim PosDsh As Long: Let PosDsh = InStr(1, CVal, "-", vbBinaryCompare)
Do While PosDsh > 0 ' Position of the dash will be returned as 0 by the Instr function if the Instr function cannot find a next dash. Also my coding below might retun me -1 at this line ---###
Dim StrtN As Long, StpN As Long ' I use these variables initially for the position of the number and then the actual number
Let StrtN = InStrRev(Left(CVal, PosDsh), " ", -1, vbBinaryCompare) + 1
Let StrtN = Mid(CVal, StrtN, PosDsh - StrtN)
Let StpN = InStr(PosDsh, CVal, ";", vbBinaryCompare)
Let StpN = Mid(CVal, PosDsh + 1, (StpN - 1) - PosDsh)
Dim NRng As String: Let NRng = StrtN & "-" & StpN
Dim Cnt
For Cnt = StrtN To StpN Step 1
Dim NRngMod As String
Let NRngMod = NRngMod & Cnt & "; "
Next Cnt
Let NRngMod = Left(NRngMod, Len(NRngMod) - 2) ' I don't need the last 2 characters of "; "
Let CVal = Replace(CVal, NRng, NRngMod & "|", 1, 1, vbBinaryCompare) ' I haver a temporary "|" to indicate the end of the last modified bit
Let PosDsh = InStr(InStr(1, CVal, "|", vbBinaryCompare), CVal, "-", vbBinaryCompare) - 1 ' because I start looking at just after the last modified part, this will return me the position of the next one, ( or 0 if none is found ) -1 is because I am reducing the length by 1 in the next code line ---###
Let CVal = Replace(CVal, "|", "", 1, 1, vbBinaryCompare)
Let NRngMod = "" ' rest this variable for next use
Loop
' 2c Modified column C output
Let CVal = Replace(CVal, ";", "", 1, -1, vbBinaryCompare) ' I don't want any ; in the modified list
Dim arrOutTempC() As String '
Let arrOutTempC() = Split(CVal, " ", -1, vbBinaryCompare)
Dim arrOutTempCT() As Variant
Let arrOutTempCT() = Application.Index(arrOutTempC(), Evaluate("=row(1:" & UBound(arrOutTempC()) + 1 & ")/row(1:" & UBound(arrOutTempC()) + 1 & ")"), Evaluate("=row(1:" & UBound(arrOutTempC()) + 1 & ")"))
' 2d All New column output
Let WsNew.Range("C" & TLeft & ":C" & TLeft + UBound(arrOutTempCT(), 1) - 1 & "").Value2 = arrOutTempCT()
Let WsNew.Range("A" & TLeft & ":A" & TLeft + UBound(arrOutTempCT(), 1) - 1 & "").Value2 = ACel.Value2 ' Name
Let WsNew.Range("B" & TLeft & ":B" & TLeft + UBound(arrOutTempCT(), 1) - 1 & "").Value2 = ACel.Offset(0, 1).Value2 ' Number
Let WsNew.Range("E" & TLeft & ":E" & TLeft + UBound(arrOutTempCT(), 1) - 1 & "").Value2 = ACel.Offset(0, 4).Value2 ' Date
Let WsNew.Range("E" & TLeft & ":E" & TLeft + UBound(arrOutTempCT(), 1) - 1 & "").NumberFormat = "m/d/yyyy"
Let WsNew.Range("F" & TLeft & ":F" & TLeft + UBound(arrOutTempCT(), 1) - 1 & "").Value2 = ACel.Offset(0, 5).Value2 ' Currency
Let WsNew.Range("G" & TLeft & ":G" & TLeft + UBound(arrOutTempCT(), 1) - 1 & "").Value2 = ACel.Offset(0, 6).Value2 ' Min
Let WsNew.Range("H" & TLeft & ":H" & TLeft + UBound(arrOutTempCT(), 1) - 1 & "").Value2 = ACel.Offset(0, 7).Value2 ' Max
Let TLeft = TLeft + UBound(arrOutTempCT(), 1) ' this should adjust our top left cell for next range of new columns
Next ACel ' ' main loop going down all name cells =========
End Sub
-
1 Attachment(s)
In the attached, update the table on the Old sheet, then on the New sheet, right-click on the table at cell J1 and choose Refresh…
Constraints: No negative numbers in the Code column, all codes should look like numbers, hyphenated code number pairs should start with the lesser value.
If you have hyphenated number-pairs that overlap (2-6;4;8;1-10) you will get duplicate rows but these can be eliminated if you want.
-
1 Attachment(s)
Alan,
This is just amazing! The macro works almost perfectly. I appreciate your help!
However, I've faced a problem: in my original list there are some codes that start with 0, for example, '060-062'. I decided to use if-clause and apparently it works, but the current problem lies in 2c part, in particular, in arrOutTempCT() that ignores nulls at the beginning of a code since it is variant and makes them just '60; 61; 62'. I've got no idea how to make it put codes without eradicating 0. I tried to change arrOutTempCT() from variant to string, but certainly it didn't work.
-
Quote:
Originally Posted by
Alex Salt
.... I decided to use if-clause and apparently it works, ......
..? ...Can you elaborate on what you mean by that, please
( Do you have any feedback for P45cal on his attempt for you )
-
1 Attachment(s)
I mean 'If...Then...Else Statement' so that the macro would add '0' at the beginning of some codes if there was one initially (otherwise it erases '0'), you can see it in the attachment. Anyways, the problem is that the macro ignores '0' at the beginning of some codes (even if I add '0' in if-statement). I wonder if there is any solution, and i think there can be something done with arrOutTempCT().
-
1 Attachment(s)
Quote:
Originally Posted by
DocAElstein
( Do you have any feedback for p45cal on his attempt for you )
We're getting .xls files but his profile shows Office 2016+ so the Power Queries should work.
In general, if someone I've tried to help completely ignores that help, I return the compliment when they later want further help.
That said, the attached includes a tweak to the query which tries to maintain the formatting.
-
1 Attachment(s)
@ P45cal
Hello Pascal
I agree with you on that. I think its inevitably going to get worse, because forums are increasingly just seen as an alternative to a Google search and/ or an answer and question section working on Artificial Intellisense. The idea of Human things like politeness and feedback is going out of fashion.
I think the forum is for extending the knowledge and encouraging discussions in Excel stuff. So regardless of OP reaction, adding extra alternative solutions like you did is always worthwhile for the greater long term good. ( In 10 years, when I finally figure out what Power Query is about , Lol, then it will be interesting to come back and see how you did here something in Power Query compared to like I did it here with VBA. )
When I finally take over this place, my first priority will be to trim out the crap and, very importantly, my main priority will be to keep the place here as long as possible. So feel free to keep adding replies. They won’t be lost!
( Just a couple of very minor points in this case though:
_ I might be responsible for the .xls files. He started with .xlsx, but I like to do everything in .xls first, so I probably first introduced using .xls and so I am responsible for any confusion on that one..
_ I think Email notifications of replies in Threads you are subscribed to may be broken at excelfox just now, so OPs might miss replies. I don’t know if it’s a temporary glitch or may need some work to fix. ( Let me know please if Email notifications are working for you, assuming you have your settings to get them.) All my setting are to get all Email notifications. But since a month they have stopped working for me.
( Because excelfox has such little traffic, my temporary solution currently is to send an extra Email to OPs to tell them about any reply, as I did for the OP in this Thread… - I have access to OPs personal EMail and I abuse that privilege at will :)
Later I intend giving that sort of "power" to all helpers , such as yourself. Those that help should have all the tools available, IMO )… )
@ Alex
Hi Alex,
Quote:
Originally Posted by
Alex Salt
...I've faced a problem: in my original list there are some codes that start with 0, for example, '060-062'. I decided to use if-clause and apparently it works, but the current problem lies in 2c part, in particular, in arrOutTempCT() that ignores nulls at the beginning of a code since it is variant and makes them just '60; 61; 62'. I've got no idea how to make it put codes without eradicating 0. I tried to change arrOutTempCT() from variant to string, but certainly it didn't work
...... i think there can be something done with arrOutTempCT()
It did sound reasonable to me initially that the transposing ( that is what arrOutTempCT() is all about ) might be the problem.
However I took a quick look here: , https://excelfox.com/forum/showthrea...ll=1#post15541 , and that transposing does not seem to be the problem. If you look at the Watch Window results, you can see we maintain our string in the array arrOutTempCT()
My guess at this stage is that we have two issues :
_(i) Code section ' 2b is using maths to modify something like 3-5 type data into 3 4 5. So this is likely always to convert 03-05 into 3 4 5
You appear to have had some success in curing that with this bit.
Code:
Dim FrstSym As String
Let FrstSym = Left(NRng, 1)
If FrstSym = 0 Then
Let NRngMod = NRngMod & "0" & Cnt & "; "
Else
Let NRngMod = NRngMod & Cnt & "; "
End If
Next Cnt
If you then look once again at your array contents, then you still have what you want : For example in your test data for row with 18; 061-069, this here: https://excelfox.com/forum/showthrea...ll=1#post15542 , is what you see.
Once again, the transpose is not the problem
It looks initially as if you have already cured the main problem yourself
_(ii) The remaining issue I think is the whole “can of worms” area of Excel deciding it knows better than you what you should see.
What Excel is doing is deciding that you are pasting in a number when you paste in like 061. It decides that the number is 61
There are a lot of different ways to overcome such problems.
The simplest way is to manually change the format of column C in the New worksheet to text, as I have done in the uploaded returned file. Basically, as I understand it, using text format short circuits Excel trying to modify anything – basically with text format you get what you give.
If you want a different solution, then we can think again later…
In short, your modified macro is giving what you want. But Excel is changing the format you give it. The simple cure I have done is manual. We can come up with various ways to overcome the problem in the coding, should you prefer to start with a virgin New worksheet with all default formats.
Alan
-
p45cal,
I'm sorry for ignoring, I completely forgot to answer you.
My point is that I need a VBA code (macro) that I could use for other worksheets. I see no macro in your solution. You solved the problem by using table-tools, which is not the thing I need.
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
-
It's my first time using forums so, please, don't be so judging, it's quite a new environment for me.
DocAElstein,
Now everything works perfectly, and you cannot imagine how I appreciate your effort and help! I wish I could pay you back equally.
-
Alls well that ends well.. :)
There are no rules about how / when you reply to any help you get.
From the side of us helpers, here at excelfox.com, it’s good to know that you have seen the reply. Even if you don’t have time to test anything you get too quickly, you can always give a short reply saying thanks.
If you are able to give feedback about if it works then even better.
It’s all voluntary.
Important for you to note if you are new to forums: There is also a lot of forums. They are all a bit different.
Places like mrexcel.com and excelforum.com have lots more traffic and you will get a lot more quicker answers there, and they can also be less personal because there are also “Excel addicts” there that rush in giving as many short answers in a day that they can. Sometimes the answers are useful, sometimes not, and all variations in between. Often you'll get the same answer a few times as the "addicts" rarely take the time to read the whole Thread, sometimes not even reading anything other than the Thread title, or first post at the most.!! Some of them are only intersted in getting their post count and merit stars or whatever up. But you can get lucky. Some of the best experts are there. The Moderators are mostly all totally insane. Try to avoid them!
This place is smaller, and it will take longer typically to get a response. But the answers may be a bit more thorough here. We are slightly more Human, and are less interested in short answer and questions.
stackoverflow.com is a forum specialising in very short quick questions and answers. You will get penalised and shat on if you try to be human and say Hello or Thank you there!!!
Take your pick, the world is thankfully full of lots of different colors and creeds.
Alan
P.S. Out of interest. – Have you been getting regular Email notifications of replies to this Thread? I only ask because they seem not to be working for some people. So I am just trying to see how bad it is, or whether just some people are affected
According to your profile, you are in Automatic Thread Subscription Mode - Instant email notification
So you should get instant notification.
I should too. But since a month it stopped working for me…..
-
Oh, that's a really useful piece of advice. Thank you for the info!
As for the notifications, I failed to sort them properly and about 2 weeks later I found excelfox's e-mails in spam box. So, that was my mistake, but the notifications themselves have been working just the way they are to.
-
Thx for the info about your EMail notifications
Good luck
-
1 Attachment(s)
Alan, no I'm not getting notifications of responses…
This one tries to preserve the leading zeroes (even if there are more than one) being guided by the length of the string directly before the hyphen:
Code:
Sub blah()
Dim Results(), Destn As Range, rngSce As Range, Sce, j, Count, SceRw, a, itm, b, Padding, i, Cde, k
Set Destn = Sheets("New").Range("A1") 'top left cell of where the results will go.
Set rngSce = Sheets("Old").Range("A1").CurrentRegion
Sce = rngSce.Value
For j = 1 To 2 '2 loops, first time to get a count of rows needed, second time to populate array
Count = 1
For SceRw = 2 To UBound(Sce)
a = Split(Application.Trim(Sce(SceRw, 3)), ";")
For Each itm In a
b = Split(Application.Trim(itm), "-")
If UBound(b) > 0 Then 'there's a hyphen:
Padding = Len(Application.Trim(b(0)))
For i = CLng(b(0)) To CLng(b(1))
Count = Count + 1
If j > 1 Then
Cde = Format(i, Application.Rept(0, Padding))
For k = 1 To UBound(Sce, 2)
Results(Count, k) = Sce(SceRw, k)
Next k
Results(Count, 3) = Cde
End If
Next i
Else 'there's no hyphen:
Count = Count + 1
If j > 1 Then
Cde = Application.Trim(b(0))
For k = 1 To UBound(Sce, 2)
Results(Count, k) = Sce(SceRw, k)
Next k
Results(Count, 3) = Cde
End If
End If
Next itm
Next SceRw
If j = 1 Then 'create new array
ReDim Results(1 To Count, 1 To UBound(Sce, 2))
For k = 1 To UBound(Sce, 2) 'populate top row of headers:
Results(1, k) = Sce(1, k)
Next k
End If
Next j
Destn.Resize(UBound(Results)).Offset(, 2).NumberFormat = "@" 'format 3rd column as Text
Destn.Resize(UBound(Results), UBound(Results, 2)).Value = Results
End Sub
-
2 Attachment(s)
Quote:
Originally Posted by
p45cal
Alan, no I'm not getting notifications of responses…
Thx. Assuming your Settings, General Settings
Attachment 3579
are the same default as mine, Instantly, using Email
Attachment 3580
then you should get Notifications.
If that’s the case , then the problem is , as usual, a bit erratic and inconsistent.
Alex, for one, seems to be getting notifications as he should. You and me aren't.
It might sort itself out. If not, I will try to look at this later, or talk to the current owner about it. ( I don’t want to trouble him just now, with the bad Corona situation in India.. )
-
1 Attachment(s)
Another Macro variation , - in a series of about a thousand different ways to do the same thing in VBA….
I have done a minor modification to my original macro offering here: https://excelfox.com/forum/showthrea...ll=1#post15550
It has a modification to overcome the problem of there are some codes that start with 0, for example, '060-062'.
I have replaced the solution of Alex’s “….'If...Then...Else Statement' so that the macro would add '0' at the beginning of some codes if there was one initially……”
Instead of using that idea of Alex, I am using the idea that P45cal has used to …. …..the leading zeroes (even if there are more than one) being guided by the length of the string before the -…..
I had thoughts of doing something like that myself originally, but I was not quite sure how to do it.
( In particular I was not quite sure how this thing works..
Format(__ , ___ )
I also did not know we have a Application.Rept( __ , ___) thing available
( ' Rept: https://docs.microsoft.com/de-de/off...tfunction.rept ) )
So I have learnt about those things thanks to P45cal's extra solution.
Just for further reference, Here is what’s going on there: ( P45cal's way of doing it, which I have copied into my latest version, Sub AlexAlanPascal() )
We use the first number in a set like 061-069 , so in that example 061, to determine the “length” of digits, which we put in variable Padding.
It will be 3 in that case:
Padding = Len(StrtN)
Padding = Len("061") = 3 ' "061" is character Length of three
Then, when we add the numbers to the string in the loop , we do it slightly differently to how I originally did it.
Instead of this line
= NRngMod & Cnt & "; "
For the example considered, we will have had:-
= NRngMod & 61 & "; "
I have now this modified line
NRngMod & Format(Cnt, Application.Rept(0, Padding)) & "; "
For the same example here we will have:-
NRngMod & Format(61, Application.Rept(0, 3)) & "; " ' Rept: https://docs.microsoft.com/de-de/off...tfunction.rept
=NRngMod & Format(61, 000) & "; "
=NRngMod & "061" & "; "
( actually, the last bit might be NRngMod & 061 & "; "
I am not quite sure exactly what is returned by Format(61, 000) , but that's less important to the overal idea )
_._________________
One small extra point of interest , which demonstrates how VBA is often kind to us and takes what looks like a number to be a number.. In some ways it shows that the disadvantage we experienced in Excel taking a text as number, can , actually, in other situations be a useful feature.
In my experience, at least in VBA, the advantages of this feature outweigh the disadvantages. But its not a clear cut thing. For me it’s a ratio of about 20%:80% in terms of Disadvantage:Advantage.
Other people may come to other conclusions, depending on their actual applications.
I use and rely on this feature a lot, because I like to use string manipulation and often like to keep numbers held as strings. For example using strings for numbers often avoids Excel’s annoying unpredictable changing of a number's format. In general, a string is taken by VBA as a string: What you give it = what you see = what you get. But, the useful thing I find is that I can use those strings in formulas and functions in VBA , and VBA will usually take them as the number they look like. We sometimes say VBA will “coerce it into a number if it can”
Example : In my coding, in the above example, I loop from
StrtN To StpN
Which comes out in the example as
"061" To "069"
In some programming languages that would crap out and error, due to something like a Type mismatch because we are putting texts where numbers are expected. But in VBA it conveniently decides its doing this
61 To 69
There will be no error, and I can continue to use those string variables in string manipulations and/ or most VBA mathamatical formulas and functions.
Using P45cal's way of doing it , for example, I am able to get the correct length of characters in order to maintain the format.
Padding = Len(StrtN)
Padding = Len("061") = 3 ' "061" is character Length of three
If I had been using number variables for things like StrtN , then that idea likely would not work in my macro, since VBA may have changd the format, removing any leading zeros...
Alan
-
Alan,
Quote:
Originally Posted by
DocAElstein
then you should get Notifications.
I confirm that those are, and have been, my settings
-
I'd use:
Code:
Sub M_snb()
sn = Sheet1.Cells(1).CurrentRegion
c01 = "1"
For j = 2 To UBound(sn)
sn(j, 3) = Replace(sn(j, 3), ",", ";")
For Each it In Filter(Split(sn(j, 3), ";"), "-")
sn(j, 3) = Replace(sn(j, 3), it, " " & Join(Evaluate("transpose(row(" & Split(it, "-")(0) & ":" & Split(it, "-")(1) & "))"), "; "))
Next
c01 = c01 & Replace(Space(UBound(Split(sn(j, 3), ";")) + 1), " ", "," & j)
c02 = c02 & ";" & sn(j, 3)
Next
sp = Application.Transpose(Split(c01, ","))
st = Split(c02, ";")
sp = Application.Index(sn, sp, [transpose(row(1:8))])
For j = 1 To UBound(st)
sp(j + 1, 3) = st(j)
sp(j + 1, 5) = CDate(sp(j + 1, 5))
Next
Cells(10, 1).Resize(UBound(sp), UBound(sp, 2)) = sp
End Sub
