Code:
Option Explicit
Sub Moshe() ' http://www.excelfox.com/forum/showthread.php/2229-complete-page-numbers
Rem 1 Make array for holding inoput data and output data - ' Input data can be handled as simple text so Array work is satisfactory
Dim arrIn() As Variant ' We know the data type can be taken as string, but I want to get the data quickly in a spreadsheet "capture" type way, using the .Value Property applied to a range object which returns a field of values for more than 1 cell returns a field of values held in Variant types, - so the type must be variant or a type mismatch runtime error will occcur
Let arrIn() = Range("A1:A" & Range("A1").CurrentRegion.Rows.Count & "").Value
Dim arrOut() As String: ReDim arrOut(1 To UBound(arrIn())) ' I can use string type to suit my final data. I also know the array size, but I must make the array a dynamic ( unknown size ) type as the Dim declare statement will only take actual numbers, but I determine my size from the size of the input array by UBound(arrIn()) : the ReDim method will accept the UBound(arrIn()) , wheras the Dim declaration syntax will not accept this, as the Dim is done at complie and not runtime
Rem 2 Effectively looping for each data row
Dim Cnt As Long ' For going through each "row"
For Cnt = 1 To UBound(arrIn()) ' Going through each element in arrIn()
'2a) split the data in a cell into an array of data. The VBA strings collection split function will return a 1 dimentsional array of string types starting at indicie 0
Dim spltEnt() As String ' For the string row split into each number entry, in other words an array of the data in a cell
If InStr(1, arrIn(Cnt, 1), ", ", vbBinaryCompare) <> 0 Then ' case more than 1 entry in cell. starting at the first character , in the current Cnt array element , I look for ", " , stipulating an excact computer match search type This Function will return eitheer the position counting from the left that it finds the first ", " or it will return 0 if it does not find at least one occurance of the ", "
Let spltEnt() = VBA.Strings.Split(arrIn(Cnt, 1), ", ", -1, vbBinaryCompare) ' we now have a number or number pair
Else ' case a single entry I cannot split by a ", " as i don't have any, ...
ReDim spltEnt(0): Let spltEnt(0) = arrIn(Cnt, 1) ' ... so i just make a single element array and put the single element in it
End If
'2b) working through each data part in a cell
Dim strOut As String 'String in each "row" '_-"Pointer" to a "Blue Print" (or Form, Questionaire not yet filled in, a template etc.)"Pigeon Hole" in Memory, sufficient in construction to house a piece of Paper with code text giving the relevant information for the particular Variable Type. VBA is sent to it when it passes it. In a Routine it may be given a particular "Value", or ("Values" for Objects). There instructions say then how to do that and handle(store) that(those). At Dim the created Paper is like a Blue Print that has some empty spaces not yet filled in. A String is a a bit tricky. The Blue Print code line Paper in the Pigeon Hole will allow to note the string Length and an Initial start memory Location. This Location well have to change frequently as strings of different length are assigned. Instructiions will tell how to do this. Theoretically a specilal value vbNullString is set to aid in quich checks.. But..http://www.mrexcel.com/forum/excel-questions/361246-vbnullstring-2.html#post44116
Dim CntX As Long ' '_-Long is very simple to handle, - final memory "size" type is known (123.456 and 000.001 have same "size" computer memory ) , and so a Address suggestion can be given for the next line when the variable is filled in. '( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster. ) https://www.mrexcel.com/forum/excel-questions/803662-byte-backward-loop-4.html
For CntX = 0 To UBound(spltEnt()) ' for going through each entry in a row in other words for going through each piece of data in a cell
'2c)(i) case just data for a single page
If InStr(1, spltEnt(CntX), "-", vbBinaryCompare) = 0 Then ' case of no "-"
Let strOut = strOut & spltEnt(CntX) & ", " ' just the single number goes in the output string, strOut
Else ' we have a "-"
Dim NmbrPear() As String ' this will be am Array of 2 elements for each number pair
Let NmbrPear() = VBA.Strings.Split(spltEnt(CntX), "-", -1, vbBinaryCompare)
'2c)(ii) case no correction needed in the data
If Len(NmbrPear(0)) = Len(NmbrPear(1)) Then ' the numbers are the same
Let strOut = strOut & spltEnt(CntX) & ", " ' the same number pair goes in the output string
Else ' from here on, we need to do some adjustment before adding to the output string
'2c)(iii) cases data correction needed
Select Case Len(NmbrPear(0)) - Len(NmbrPear(1)) ' selecting the case of the difference in length of the two parts of the data "FirstNumberPart-SecondNumberPart"
Case 1 ' Like 123-24 or 12345-2345
Let NmbrPear(1) = VBA.Strings.Mid$(NmbrPear(0), 1, 1) & NmbrPear(1) ' like 1 & 24 or 1 & 2345 ' VBA strings collection Mid Function: This returns the part of ( NmbrPear(0) , the starts at character 1 , and has the length of 1 character )
Case 2 ' like 123-4
Let NmbrPear(1) = VBA.Strings.Mid$(NmbrPear(0), 1, 2) & NmbrPear(1) ' like 12 & 4
Case 3 ' like 1234-6
Let NmbrPear(1) = VBA.Strings.Mid$(NmbrPear(0), 1, 3) & NmbrPear(1) ' like 123 & 6
Case 3 ' like 12345-8
Let NmbrPear(1) = VBA.Strings.Mid$(NmbrPear(0), 1, 4) & NmbrPear(1) ' like 1234 & 8
End Select ' at this point we have corrected our second number part from the pair
Let strOut = strOut & VBA.Strings.Join(NmbrPear(), "-") & ", " ' The number pair is rejoined with the corrected second number part before adding the number parts pair to the output string
End If
End If
Next CntX
'2d) The string of corrected data can now be added to the array for output
Let strOut = VBA.Strings.Left$(strOut, Len(strOut) - 2) ' This removes the last unwanted ", " ' 'VBA Strings collection Left function returns a Variant- initially tries to coerces the first parameter into Variant, Left$ does not, that's why Left$ is preferable over Left, it's theoretically slightly more efficient, as it avoids the overhead/inefficieny associated with the Variant. It allows a Null to be returned if a Null is given. https://www.excelforum.com/excel-new...ml#post4084816 .. it is all to do with ya .."Null propagation".. maties ;) '_-.. http://allenbrowne.com/casu-12.html Null is a special "I do not know, / answer unknown" - handy to hav... propogetion wonks - math things like = 1+2+Null returns you null. Or string manipulation stuff like, left(Null returns you Null. Count things like Cnt (x,y,Null) will return 2 - there are two known things there..Hmm - bit iffy although you could argue that Null has not been entered yet.. may never
Let arrOut(Cnt) = strOut ' Finally the string is aded to the current "row" in the outout array
Let strOut = "" ' Empty variable holding a row string for use ijn next loop
Next Cnt
Rem 3 I have the final data array, and so umst now paste it out where I want it.
Dim arrClmOut() As String: ReDim arrClmOut(1 To UBound(arrOut), 1 To 1) ' This is for a 1 column 2 Dimensional array which I need for the orientation of my final output
'3(i) a simple loop to fill the transposed array
Dim rCnt As Long '
For rCnt = 1 To UBound(arrOut())
Let arrClmOut(rCnt, 1) = arrOut(rCnt)
Next rCnt
'3(ii) Output to worksheet
Let Range("B1").Resize(UBound(arrOut())).Value = arrClmOut() ' The cell Top left of where the output should go is resized to the required row size, and 1 column. The .Value Property of that range object may have the values in an Array assigned to it in a simpla one line assignment
End Sub
'
'
'
' http://www.excelfox.com/forum/showthread.php/2157-Re-Defining-multiple-variables-in-VBA?p=10192#post10192
' https://www.excelforum.com/word-programming-vba-macros/1175184-vba-word-repeat-character-in-string-a-number-of-times.html#post4591171
Reply With Quote
Bookmarks