VBA Macro which create new lines by codes

**Alex Salt** · 04-22-2021, 04:26 PM

**DocAElstein** · 04-23-2021, 07:20 PM

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

**p45cal** · 05-03-2021, 07:50 PM

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.

**Alex Salt** · 05-06-2021, 08:06 PM

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.

**DocAElstein** · 05-06-2021, 09:28 PM

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 )

**Alex Salt** · 05-07-2021, 12:22 AM

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().

**p45cal** · 05-07-2021, 03:22 AM

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.

**DocAElstein** · 05-07-2021, 11:47 AM

@ 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,

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

**Alex Salt** · 05-07-2021, 11:50 AM

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

**Alex Salt** · 05-07-2021, 01:49 PM

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.