Notes tests, text files, manipulation of text files in Excel and with Excel VBA CSV stuff

**DocAElstein** · 11-24-2020, 02:23 PM

For Ozgrid post results see here: https://excelfox.com/forum/showthrea...ll=1#post15144

In support of this Thread
http://www.eileenslounge.com/viewtopic.php?f=30&t=35732

Code:

' 
Sub WtchaGot_Unic_NotMuchIfYaChoppedItOff(ByVal strIn As String, Optional ByVal FlNme As String) '
Rem 1  ' Output "sheet hardcopies"
'1a) Worksheets     'Make Temporary Sheets, if not already there, in Current Active Workbook, for a simple list of all characters, and for pasting the string into worksheet cells
'1a)(i) Full list of characters worksheet
    If Not Evaluate("=ISREF(" & "'" & "WotchaGotInString" & "'!Z78)") Then '   ( the '  are not important here, but in general allow for a space in the worksheet name like  "Wotcha Got In String"
    Dim Wb As Workbook '                                   ' ' Dim:  ' Preparing a "Pointer" to an Initial "Blue Print" in Memory of the Object ( Pigeon Hole with a bit of paper or code lines on that can be filled in to refer to a specific Objec of this type ) . This also us to get easily at the Methods and Properties throught the applying of a period ( .Dot) ( intellisense )                     '
     Set Wb = ActiveWorkbook '  '                            Set now (to Active Workbook - one being "looked at"), so that we carefull allways referrence this so as not to go astray through Excel Guessing inplicitly not the one we want...         Set: Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed.      http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191                                '
     Wb.Worksheets.Add After:=Wb.Worksheets.Item(Worksheets.Count) 'A sheeet is added and will be Active
    Dim Ws As Worksheet '
     Set Ws = ActiveSheet 'Rather than rely on always going to the active sheet, we referr to it Explicitly so that we carefull allways referrence this so as not to go astray through Excel Guessing implicitly not the one we want...    Set: Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed.      http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191            ' Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed.      http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191
     Ws.Activate: Ws.Cells(1, 1).Activate ' ws.Activate and activating a cell sometimes seemed to overcome a strange error
     Let Ws.Name = "WotchaGotInString"
    Else ' The worksheet is already there , so I just need to set my variable to point to it
     Set Ws = ThisWorkbook.Worksheets("WotchaGotInString")
    End If
'1a(ii) Worksheet to paste out string into worksheet cells
    If Not Evaluate("=ISREF(" & "'" & "StrIn|WtchaGot" & "'!Z78)") Then
     Set Wb = ActiveWorkbook
     Wb.Worksheets.Add After:=Wb.Worksheets.Item(1)
    Dim Ws1 As Worksheet
     Set Ws1 = ActiveSheet
     Ws1.Activate: Ws1.Cells(1, 1).Activate
     Let Ws1.Name = "StrIn|WtchaGot"
    Else
     Set Ws1 = ThisWorkbook.Worksheets("StrIn|WtchaGot")
    End If
'1b) Array
Dim myLenf As Long: Let myLenf = Len(strIn)  '            ' 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
Dim arrWotchaGot() As String: ReDim arrWotchaGot(1 To myLenf + 1, 1 To 2) ' +1 for header  Array for the output 2 column list.  The type is known and the size,  but I must use this ReDim  method simply because the dim statement  Dim( , )  is complie time thing and will only take actual numbers
 Let arrWotchaGot(1, 1) = FlNme & vbLf & Format(Now, "DD MMM YYYY") & vbLf & "Lenf is   " & myLenf: Let arrWotchaGot(1, 2) = Left(strIn, 40)
Rem 2  String anylaysis
'Dim myLenf As Long: Let myLenf = Len(strIn)
Dim Cnt As Long
    For Cnt = 1 To myLenf ' ===Main Loop========================================================================
    ' Character analysis: Get at each character
    Dim Caracter As Variant ' String is probably OK.
    Let Caracter = Mid(strIn, Cnt, 1) ' '    the character in strIn at position from the left of length 1
    '2a) The character added to a single  WotchaGot  long character string to look at and possibly use in coding
    Dim WotchaGot As String ' This will be used to make a string that I can easilly see and also is in a form that I can copy and paste in a code line  required to build the full string of the complete character string
        '2a)(i) Most common characters and numbers to be displayed as "seen normally" ' -------2a)(i)--
        If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Or Caracter Like "[a-z]" Then ' Check for normal characters
            'SirNirios
            If Not Cnt = 1 Then ' I am only intersted in next line comparing the character before, and if i did not do this the next line would error if first character was a  "normal"  character
                If Not Cnt = myLenf And (Mid(strIn, Cnt - 1, 1) Like "[A-Z]" Or Mid(strIn, Cnt - 1, 1) Like "[0-9]" Or Mid(strIn, Cnt - 1, 1) Like "[a-z]") Then  ' And (Mid(strIn, Cnt + 1, 1) Like "[A-Z]" Or Mid(strIn, Cnt + 1, 1) Like "[0-9]" Or Mid(strIn, Cnt + 1, 1) Like "[a-z]") Then
                 Let WotchaGot = WotchaGot & "|LinkTwoNormals|"
                Else
                End If
            Else
            End If
        Let WotchaGot = WotchaGot & """" & Caracter & """" & " & " ' This will give the sort of output that I need to write in a code line, so for example if I have a123 , this code line will be used 4 times and give like a final string for me to copy of   "a" & "1" & "2" & "3" &      I would phsically need to write in code  like  strVar = "a" & "1" & "2" & "3"   -  i could of course also write  = "a123"   but the point of this routine is to help me pick out each individual element
        Else ' Some other things that I would like to "see" normally - not "normal simple character" - or by a VBA constant, like vbCr vbLf  vbTab
         Select Case Caracter ' 2a)(ii)_1
          Case " "
           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
          Case "!"
           Let WotchaGot = WotchaGot & """" & "!" & """" & " & "
          Case "$"
           Let WotchaGot = WotchaGot & """" & "$" & """" & " & "
          Case "%"
           Let WotchaGot = WotchaGot & """" & "%" & """" & " & "
          Case "~"
           Let WotchaGot = WotchaGot & """" & "~" & """" & " & "
          Case "&"
           Let WotchaGot = WotchaGot & """" & "&" & """" & " & "
          Case "("
           Let WotchaGot = WotchaGot & """" & "(" & """" & " & "
          Case ")"
           Let WotchaGot = WotchaGot & """" & ")" & """" & " & "
          Case "/"
           Let WotchaGot = WotchaGot & """" & "/" & """" & " & "
          Case "\"
           Let WotchaGot = WotchaGot & """" & "\" & """" & " & "
          Case "="
           Let WotchaGot = WotchaGot & """" & "=" & """" & " & "
          Case "?"
           Let WotchaGot = WotchaGot & """" & "?" & """" & " & "
          Case "'"
           Let WotchaGot = WotchaGot & """" & "'" & """" & " & "
          Case "+"
           Let WotchaGot = WotchaGot & """" & "+" & """" & " & "
          Case "-"
           Let WotchaGot = WotchaGot & """" & "-" & """" & " & "
          Case "_"
           Let WotchaGot = WotchaGot & """" & "_" & """" & " & "
          Case "."
           Let WotchaGot = WotchaGot & """" & "." & """" & " & "
          Case ","
           Let WotchaGot = WotchaGot & """" & "," & """" & " & "
          Case ";"
           Let WotchaGot = WotchaGot & """" & ";" & """" & " & "
          Case ":"
           Let WotchaGot = WotchaGot & """" & ":" & """"
          Case vbCr
           Let WotchaGot = WotchaGot & "vbCr & "  ' I actuall would write manually in this case like     vbCr &
          Case vbLf
           Let WotchaGot = WotchaGot & "vbLf & "
          Case vbCrLf
           Let WotchaGot = WotchaGot & "vbCrLf & "
          Case vbNewLine
           Let WotchaGot = WotchaGot & "vbNewLine & "
          Case """"   ' This is how to get a single   "    No one is quite sure how this works.  My theory that,  is as good as any other,  is that  syntaxly   """"    or  "  """  or    """    "   are accepted.   But  in that the  """  bit is somewhat strange for VBA.   It seems to match  the first and Third " together as a  valid pair   but  the other  " in the middle of the  3 "s is also syntax OK, and does not error as    """     would  because  of the final 4th " which it syntaxly sees as a valid pair matched simultaneously as it does some similar check on the  first  and Third    as a concluding  string pair.  All is well except that  the second  "  is captured   within a   accepted  enclosing pair made up of the first and third  "   At the same time the 4th  "  is accepted as a final concluding   "   paired with the   second which it is  using but at the same time now isolated from.
           Let WotchaGot = WotchaGot & """" & """" & """" & """" & " & "                                ' The reason why  ""  ""   would not work is that    at the end of the  "" the next empty  character signalises the end of a  string pair, and only if  it saw a " would it keep checking the syntax rules which  then lead in the previous case to  the situation described above.
          Case vbTab
           Let WotchaGot = WotchaGot & "vbTab & "
          ' 2a)(iii)
            Case Else
                If AscW(Caracter) < 256 Then
                 Let WotchaGot = WotchaGot & "Chr(" & AscW(Caracter) & ")" & " & "
                Else
                 Let WotchaGot = WotchaGot & "ChrW(" & AscW(Caracter) & ")" & " & "
                End If
            'Let CaseElse = Caracter
        End Select
        End If ' End of the "normal simple character" or not ' -------2a)------Ended-----------
    '2b)  A 2 column Array for convenience of a list
     Let arrWotchaGot(Cnt + 1, 1) = Cnt & "           " & Caracter: Let arrWotchaGot(Cnt + 1, 2) = AscW(Caracter) ' +1 for header
    Next Cnt ' ========Main Loop=================================================================================
    '2c) Some tidying up
    If WotchaGot <> "" Then
     Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3) ' take off last " & "    ( 2 spaces one either side of a  & )
     Let WotchaGot = Replace(WotchaGot, """ & |LinkTwoNormals|""", "", 1, -1, vbBinaryCompare)
     ' The next bit changes like this  "Lapto" & "p"  to  "Laptop"   You might want to leave it out ti speed things up a bit
        If Len(WotchaGot) > 5 And (Mid(WotchaGot, Len(WotchaGot) - 1, 1) Like "[A-Z]" Or Mid(WotchaGot, Len(WotchaGot) - 1, 1) Like "[0-9]" Or Mid(WotchaGot, Len(WotchaGot) - 1, 1) Like "[a-z]") And (Mid(WotchaGot, Len(WotchaGot) - 7, 1) Like "[A-Z]" Or Mid(WotchaGot, Len(WotchaGot) - 7, 1) Like "[0-9]" Or Mid(WotchaGot, Len(WotchaGot) - 7, 1) Like "[a-z]") And Mid(WotchaGot, Len(WotchaGot) - 6, 5) = """" & " & " & """" Then
         Let WotchaGot = Left$(WotchaGot, Len(WotchaGot) - 7) & Mid(WotchaGot, Len(WotchaGot) - 1, 2) '  Changes like this  "Lapto" & "p"  to  "Laptop"
        Else
        End If
    Else
    End If
Rem 3 Output
'3a) String
'3a)(i)
MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot ' Hit Ctrl+g from the VB Editor to get a copyable version of the entire string
'3a)(ii)
Ws1.Activate: Ws1.Cells.Item(1, 1).Activate
Dim Lr1 As Long: Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count).End(xlUp).Row     '   http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466      Making Lr dynamic ( using rng.End(XlUp) for a single column. )
 Let Ws1.Range("A" & Lr1 + 1 & "").Value = FlNme
 Let Ws1.Range("B" & Lr1 + 1 & "").Value = strIn
 Let Ws1.Range("C" & Lr1 + 1 & "").Value = WotchaGot
 Ws1.Cells.Columns.AutoFit
'3b) List
Dim NxtClm As Long: Let NxtClm = 1 ' In conjunction with next  If  this prevents the first column beine taken as 0 for an empty worksheet
 Ws.Activate: Ws.Cells.Item(1, 1).Activate
 If Not Ws.Range("A1").Value = "" Then Let NxtClm = Ws.Cells.Item(1, Columns.Count).End(xlToLeft).Column + 1
 Let Ws.Cells.Item(1, NxtClm).Resize(UBound(arrWotchaGot(), 1), UBound(arrWotchaGot(), 2)).Value = arrWotchaGot()
 Ws.Cells.Columns.AutoFit
End Sub
'
' https://excelfox.com/forum/showthread.php/1546-TESTING-Column-Letter-test-Sort-Last-Row?p=7214#post7214
Public Function CL(ByVal lclm As Long) As String '         http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213980
    Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
End Function

'    Lets have a look at a bit of the text file
Sub LookInFirstBitOfTextString()
Dim FileNum As Long: Let FileNum = FreeFile(1)                                                                               ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String, FlNme As String
 Let PathAndFileName = ThisWorkbook.Path & "\" & "ttFirstBit" '
Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
TotalFile = Space(LOF(FileNum)) '....and wot recives it hs to be a string of exactly the right length
Get #FileNum, , TotalFile
Close #FileNum
' What is in this string?
Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(TotalFile, FlNme)
End Sub

Share ‘tt_ExtraminationsRock.xlsm’ : https://app.box.com/s/z3nr7ecnj540rond1437bo48wmaxsbch
Share ‘ttFirstBit.txt’ : https://app.box.com/s/zzeqis8qhdfbzj68fzyficdfszh2tjoo

**DocAElstein** · 11-24-2020, 02:36 PM

continued from last post

ttFirstBit.txt

Code:




                Playlist Name           Curator       Genres                 Followers    Best Way To Contact                Spotify Link
                                                                                             felix@pro-gamer-gear.de
                                                                                8,350
                #1 Gaming Playlist     Felix Krissmayr  RAP, ROCK, HIP HOP, POST-GRUNGE, EDM, POP, HARD ROCK, 

ELECTRONIC, PROGRESSIVE HOUSE, INDIETRONICA, METAL, SOUNDTRACK, PUNK, BROSTEP, HOUSE
                                                                                                                 

https://open.spotify.com/playlist/1DRpqg3Vlub1gKMWN14gCg
                    #Part?y

After running macro

Code:

Sub LookInFirstBitOfTextString()
Dim FileNum As Long: Let FileNum = FreeFile(1)                                                                               ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String, FlNme As String
 Let FlNme = "ttFirstBit.txt"
 Let PathAndFileName = ThisWorkbook.Path & "\" & FlNme '
Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
TotalFile = Space(LOF(FileNum)) '....and wot recives it hs to be a string of exactly the right length
Get #FileNum, , TotalFile
Close #FileNum
' What is in this string?
Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(TotalFile, FlNme)
End Sub

results:

Code:

vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & "Playlist" & " " & "Name" & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & "Curator" & " " & " " & " " & " " & " " & " " & " " & "Genres" & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & "Followers" & " " & " " & " " & " " & "Best" & " " & "Way" & " " & "To" & " " & "Contact" & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & "Spotify" & " " & "Link" & vbCr & vbLf & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & "
 " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & "felix" & Chr(64) & "pro" & "-" & "gamer" & "-" & "gear" & "." & "de" & vbCr & vbLf & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & "8" & "," & "350" & vbCr & vbLf & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & Chr(35) & "1" & " " & "Gaming" & " " & "Playlist" & " " & " " & " " & " " & " " & "Felix" & " " & "Krissmayr" & " " & " " & "RAP" & "," 
& " " & "ROCK" & "," & " " & "HIP" & " " & "HOP" & "," & " " & "POST" & "-" & "GRUNGE" & "," & " " & "EDM" & "," & " " & "POP" & "," & " " & "HARD" & " " & "ROCK" & "," & " " & "ELECTRONIC" & "," & " " & "PROGRESSIVE" & " " & "HOUSE" & "," & " " & "INDIETRONICA" & "," & " " & "METAL" & "," & " " & "SOUNDTRACK" & "," & " " & "PUNK" & "," & " " & "BROSTEP" & "," & " " & "HOUSE" & vbCr & vbLf & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " 
& " " & " " & " " & " " & " " & " " & " " & " " & "https" & ":" & "/" & "/" & "open" & "." & "spotify" & "." & "com" & "/" & "playlist" & "/" & "1DRpqg3Vlub1gKMWN14gCg" & vbCr & vbLf & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & Chr(35) & "Part" & "?" & "y"

**DocAElstein** · 11-24-2020, 04:15 PM

continued from last post

Code:

Sub ConventionalTextImport()    '   http://www.eileenslounge.com/viewtopic.php?f=30&t=35100&p=274367#p274367      http://www.eileenslounge.com/viewtopic.php?f=30&t=34629&p=274370#p274370    http://www.eileenslounge.com/viewtopic.php?p=274721#p274721
Rem 1 Worksheets info, (any worksheet will do to paste out to)
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets.Item("ConventionalTextImport")
Rem 2 Text file info
' 2a) get the text file as a long single string
Dim FileNum As Long: Let FileNum = FreeFile(1)                                  ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String
 Let PathAndFileName = ThisWorkbook.Path & Application.PathSeparator & "tt.txt"   '                                                               CHANGE TO SUIT                                                                                                         From vixer zyxw1234  : http://www.eileenslounge.com/viewtopic.php?f=30&t=34629     DF.txt https://app.box.com/s/gw941dh9v8sqhvzin3lo9rfc67fjsbic
Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
TotalFile = Space(LOF(FileNum)) '....and wot recives it has to be a string of exactly the right length
Get #FileNum, , TotalFile:                                               Debug.Print TotalFile
Close #FileNum
' Let TotalFile = Replace(TotalFile, """", "", 1, -1, vbBinaryCompare):   Debug.Print TotalFile  '   removed enclosing quotes in  rabsofty's  text file
' Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(TotalFile)
' 2b) Split into wholes line _ splitting the text file into rows by splitting by Line Seperator
Dim arrRws() As String: Let arrRws() = Split(TotalFile, vbCr & vbLf, -1, vbBinaryCompare)
Dim RwCnt As Long: Let RwCnt = UBound(arrRws()) + 1    '  +1 is nedeed as the  Split Function  returns indicies 0 1 2 3 4 5   etc...
'' 2c) split first line to determine the Field(column) number
'Dim arrClms() As String: Let arrClms() = Split(arrRws(0), ",", -1, vbBinaryCompare)
'Dim ClmCnt As Long: Let ClmCnt = UBound(arrClms()) + 1
Dim ClmCnt As Long: Let ClmCnt = 1
' 2d) we can now make an array for all the rows, and we know our columns are A-J = 10 columns
Dim arrOut() As String: ReDim arrOut(1 To RwCnt, 1 To ClmCnt)

Rem 3 An array is built up by _....
Dim Cnt As Long
    For Cnt = 1 To RwCnt '               _.. considering each row of data
    'Dim arrClms() As String
'     Let arrClms() = Split(arrRws(Cnt - 1), ",", -1, vbBinaryCompare)  '  ___.. splitting each row into columns by splitting by the comma
'    Dim Clm As Long   '
'        For Clm = 1 To UBound(arrClms()) + 1
'         Let arrOut(Cnt, Clm) = arrClms(Clm - 1)                           ' At each of these "inner" loops  we fill either a the array with an element
          Let arrOut(Cnt, 1) = arrRws(Cnt - 1)
'        Next Clm
    Next Cnt

Rem 4  Finally the array is pasted to  worksheet
Dim RngOut As Range: Set RngOut = Ws1.Range("A1").Resize(RwCnt, ClmCnt)
 RngOut.ClearContents
 Let RngOut.Value = arrOut()
' 4b Option to remove the  little   ...    when i click on any cell that has output there is an option numbers stored as text, convert to numbers,help on this error,ignore error,edit in formula bar,error checking options(these are the options coming)…
 Let RngOut.Value = Evaluate("=IF(" & RngOut.Address & "="""","""",IF(ISNUMBER(1*" & RngOut.Address & "),1*" & RngOut.Address & "," & RngOut.Address & "))")   '    http://www.eileenslounge.com/viewtopic.php?p=272704#p272704
End Sub

**DocAElstein** · 11-25-2020, 02:47 AM

tt2.txt

Code:

vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & "                Playlist Name           Curator       Genres                 Followers    Best Way To Contact                Spotify Link" & vbCr & vbLf & "                                                                                             felix" & Chr(64) & "pro" & "-" & "gamer" & "-" & "gear" & "." & "de" & vbCr & vbLf & "                                                                                8" & "," & "350" & vbCr & vbLf & "                " & "#" & "1 Gaming Playlist     Felix Krissmayr  RAP" & "," & " ROCK" & "," & " HIP HOP" & "," & " POST" & "-" & "GRUNGE" & "," & " EDM" & "," & " POP" & "," & " HARD ROCK" & "," & " ELECTRONIC" & "," & " PROGRESSIVE HOUSE" & "," & " INDIETRONICA" & "," & " METAL" & "," & " SOUNDTRACK" & "," & " PUNK" & "," & " BROSTEP" & "," & " HOUSE" & vbCr & vbLf & "                                                                                                                 https" & ":" & "/
" & "/" & "open" & "." & "spotify" & "." & "com" & "/" & "playlist" & "/" & "1DRpqg3Vlub1gKMWN14gCg" & vbCr & vbLf & "                    " & "#" & "Part" & "?" & "y             handiofiblood  ROCK" & "," & " POP" & "," & " R" & "&" & "B" & "," & " EDM" & "," & " HIP HOP  1" & "," & "816   handofblood" & Chr(64) & "instinct3" & "." & "de  https" & ":" & "/" & "/" & "open" & "." & "spotify" & "." & "com" & "/" & "playlist" & "/" & "0Zx5bp0guBk949wzBoxMQX" & vbCr & vbLf & "                                                                                            http" & ":" & "/" & "/" & "reddit" & "." & "com" & "/" & "r" & "/" & "listentothis" & vbCr & vbLf & "                  " & "/" & "r" & "/" & "listentothis     Andreas Karlsson  SINGER" & "/" & "SONGWRITER" & "," & " DANCE" & "," & " POP" & "," & " INDIE" & "," & " REGGAE" & "," & " ROCK" & "," & " INDIE ROCK" & "," & " POP PUNK" & "," & " ALTERNATIVE" & "," & " PUNK" & "," & " HIP HOP" & "," & " PSYCHEDELIC https" & ":" & "/" & "/" & "open" & "." & "s
potify" & "." & "com" & "/" & "playlist" & "/" & "6qZnImkqxbRtL9FiwqHkGK" & vbCr & vbLf & "                                                                                17" & "," & "311" & vbCr & vbLf & "            100" & "+" & " best new alternative " & "&" & " indie hits  Trackdiggers  INDIE" & "," & " ALTERNATIVE" & "," & " FOLK" & "-" & "POP" & "," & " INDIE POP" & "," & " INDIETRONICA" & "," & " DANCE PUNK" & "," & " TRIPHOP" & "," & " SINGER" & "/" & "SONGWRITER" & "," & " CHILLWAVE" & "," & " PREVERB" & "," & " ELECTRONIC" & "," & " PSYCHEDELIC" & vbCr & vbLf & "                                                                                 382" & vbCr & vbLf & "                                                                                             trackdiggers" & Chr(64) & "gmail" & "." & "com" & vbCr & vbLf & "                                                                                                                  https" & ":" & "/" & "/" & "open" & "." & "spotify" & "." & "com" & "
/" & "playlist" & "/" & "2GsA39IcGmgHldG8Jyqok6" & vbCr & vbLf & "                                                                                               info" & Chr(64) & "spingrey" & "." & "com" & vbCr & vbLf & "                                                                                21" & "," & "410" & vbCr & vbLf & "                 A Sunday Spring         SpinGrey     POP" & "," & " R" & "&" & "B" & "," & " INDIE" & "," & " INDIETRONICA" & "," & " RAP" & "," & " INDIE POP" & "," & " HIP HOP" & "," & " SOUL" & "," & " FUNK" & "," & " FOLK" & "-" & "POP" & "," & " ROCK   https" & ":" & "/" & "/" & "open" & "." & "spotify" & "." & "com" & "/" & "playlist" & "/" & "1KpzhrvBZHfwnXayCMAQiY" & vbCr & vbLf

**DocAElstein** · 11-26-2020, 02:45 PM

tt.txt

Approximately a quarter of it:-

Code:

vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & vbCr & vbLf & "                Playlist Name           Curator       Genres                 Followers    Best Way To Contact                Spotify Link" & vbCr & vbLf & "                                                                                             felix" & "@" & "pro" & "-" & "gamer" & "-" & "gear" & "." & "de" & vbCr & vbLf & "                                                                                8" & "," & "350" & vbCr & vbLf & "                " & "#" & "1 Gaming Playlist     Felix Krissmayr  RAP" & "," & " ROCK" & "," & " HIP HOP" & "," & " POST" & "-" & "GRUNGE" & "," & " EDM" & "," & " POP" & "," & " HARD ROCK" & "," & " ELECTRONIC" & "," & " PROGRESSIVE HOUSE" & "," & " INDIETRONICA" & "," & " METAL" & "," & " SOUNDTRACK" & "," & " PUNK" & "," & " BROSTEP" & "," & " HOUSE" & vbCr & vbLf & "                                                                                                                 https" & ":" & "/" & 
"/" & "open" & "." & "spotify" & "." & "com" & "/" & "playlist" & "/" & "1DRpqg3Vlub1gKMWN14gCg" & vbCr & vbLf & "                    " & "#" & "Part" & "?" & "y             handiofiblood  ROCK" & "," & " POP" & "," & " R" & "&" & "B" & "," & " EDM" & "," & " HIP HOP  1" & "," & "816   handofblood" & "@" & "instinct3" & "." & "de  https" & ":" & "/" & "/" & "open" & "." & "spotify" & "." & "com" & "/" & "playlist" & "/" & "0Zx5bp0guBk949wzBoxMQX" & vbCr & vbLf & "                                                                                            http" & ":" & "/" & "/" & "reddit" & "." & "com" & "/" & "r" & "/" & "listentothis" & vbCr & vbLf & "                  " & "/" & "r" & "/" & "listentothis     Andreas Karlsson  SINGER" & "/" & "SONGWRITER" & "," & " DANCE" & "," & " POP" & "," & " INDIE" & "," & " REGGAE" & "," & " ROCK" & "," & " INDIE ROCK" & "," & " POP PUNK" & "," & " ALTERNATIVE" & "," & " PUNK" & "," & " HIP HOP" & "," & " PSYCHEDELIC https" & ":" & "/" & "/" & "open" & "." & "spotify" 
& "." & "com" & "/" & "playlist" & "/" & "6qZnImkqxbRtL9FiwqHkGK" & vbCr & vbLf & "                                                                                17" & "," & "311" & vbCr & vbLf & "            100" & "+" & " best new alternative " & "&" & " indie hits  Trackdiggers  INDIE" & "," & " ALTERNATIVE" & "," & " FOLK" & "-" & "POP" & "," & " INDIE POP" & "," & " INDIETRONICA" & "," & " DANCE PUNK" & "," & " TRIPHOP" & "," & " SINGER" & "/" & "SONGWRITER" & "," & " CHILLWAVE" & "," & " PREVERB" & "," & " ELECTRONIC" & "," & " PSYCHEDELIC" & vbCr & vbLf & "                                                                                 382" & vbCr & vbLf & "                                                                                             trackdiggers" & "@" & "gmail" & "." & "com" & vbCr & vbLf & "                                                                                                                  https" & ":" & "/" & "/" & "open" & "." & "spotify" & "." & "com" & "/" & "playli
st" & "/" & "2GsA39IcGmgHldG8Jyqok6" & vbCr & vbLf & "                                                                                               info" & "@" & "spingrey" & "." & "com" & vbCr & vbLf & "                                                                                21" & "," & "410" & vbCr & vbLf & "                 A Sunday Spring         SpinGrey     POP" & "," & " R" & "&" & "B" & "," & " INDIE" & "," & " INDIETRONICA" & "," & " RAP" & "," & " INDIE POP" & "," & " HIP HOP" & "," & " SOUL" & "," & " FUNK" & "," & " FOLK" & "-" & "POP" & "," & " ROCK   https" & ":" & "/" & "/" & "open" & "." & "spotify" & "." & "com" & "/" & "playlist" & "/" & "1KpzhrvBZHfwnXayCMAQiY" & vbCr & vbLf & "                                                                                4" & "," & "510" & vbCr & vbLf & "                                                                                        https" & ":" & "/" & "/" & "www" & "." & "instagram" & "." & "com" & "/" & "andrewduong77" & vbCr & vbLf & 
"            Adult Contemporary" & "," & " Soft Rock" & "," & " Pop  Andrew Duong  SOFT ROCK" & "," & " POP" & "," & " SINGER" & "/" & "SONGWRITER" & "," & " DISCO" & "," & " R" & "&" & "B" & "," & " HARD ROCK" & "," & " MOTOWN" & "," & " POST" & "-" & "GRUNGE" & "," & "FUNK" & "," & " SYNTH POP" & "," & " FOLK" & "," & " SOUL" & "," & " COUNTRY" & "," & " FOLK POP https" & ":" & "/" & "/" & "open" & "." & "spotify" & "." & "com" & "/" & "playlist" & "/" & "7iLpBTFFlNJNUfGuiJdvqw" & vbCr & vbLf & "                                                                                             tinydesk" & "@" & "bobboilen" & "." & "info" & vbCr & vbLf & "                All Songs Considered    NPR Music     INDIE ROCK" & "," & " ALTERNATIVE" & "," & " ROCK" & "," & " FOLK" & "," & " SINGER" & "/" & "SONGWRITER" & "," & " SOUL" & "," & " R" & "&" & "B" & "," & " ROOTS" & "," & " HIP HOP" & "," & "BLUEGRASS" & "," & " BLUES" & "," & " POP" & "," & " INDIETRONICA" & "," & " PUNK" & "," & " HARDCORE" & "," & " WORLD 
MUSIC" & vbCr & vbLf & "                                                                                20" & "," & "095" & vbCr & vbLf & "                                                                                                                   https" & ":" & "/" & "/" & "open" & "." & "spotify" & "." & "com" & "/" & "playlist" & "/" & "7ro9wf8vuSLGxStaC8t8Rv" & vbCr & vbLf & "                                                                                36" & "," & "180" & vbCr & vbLf & "               Alternative Rap Bangers  Marcin Mrotek  HIP HOP" & "," & " ALTERNATIVE" & "," & " ROCK" & "," & " INDIE ROCK" & "," & " POP   altrockplaylist" & "@" & "gmail" & "." & "com   https" & ":" & "/" & "/" & "open" & "." & "spotify" & "." & "com" & "/" & "playlist" & "/" & "7xBH6HAUcaxLpAK5xv0Gso" & vbCr & vbLf & "                                                                                157" & "," & "723" & vbCr & vbLf & "                alxrnbrdmusic Playlists   alexrainbirdmusic    INDIE POP" & ","
 & " INDIE ROCK" & "," & " FOLK" & "," & " FOLK" & "-" & "POP" & "," & " ACOUSTIC" & "," & " ROCK" & "," & " POP" & "," & " ALTERNATIVE alexrainbirdmusic" & "@" & "gmail" & "." & "com    https" & ":" & "/" & "/" & "open" & "." & "spotify" & "." & "com" & "/" & "user" & "/" & "alxrnbrdmusic" & vbCr & vbLf & "                  Anthropologie        carolinejoyrector  ROOTS" & "," & " AMERICANA" & "," & " FOLK" & "-" & "POP" & "," & " POP" & "," & " SOUL" & "," & " INDIE ROCK   unfancyblog" & "@" & "gmail" & "." & "com   https" & ":" & "/" & "/" & "open" & "." & "spotify" & "." & "com" & "/" & "playlist" & "/" & "1UzFdewdE4cqe53CUU3J0D" & vbCr & vbLf & "                                                                                1" & "," & "131" & vbCr & vbLf & "           Audiophile Reference Headphone Bliss  losshack  POP" & "," & " ROCK" & "," & " INDIE" & "," & " SINGER" & "/" & "SONGWRITER" & "," & " BLUES" & "," & " INSTRUMENTAL" & "," & " FOLK" & "-" & "POP  losshack" & "@" & "gmail" & "." & "com   htt
ps" & ":" & "/" & "/" & "open" & "." & "spotify" & "." & "com" & "/" & "playlist" & "/" & "55hNEtHhJ1fprtrcm1rD2I" & vbCr & vbLf & "                                                                                3" & "," & "968" & vbCr & vbLf & "           Audiophile test music " & "(" & "Hifi High Quality" & ")" & "  Ben Koomen   POP" & "," & " JAZZ" & "," & " BLUES" & "," & " ELECTRONIC" & "," & " ACOUSTIC" & "," & " SINGER" & "/" & "SONGWRITER" & "," & " LATIN" & "," & " CLASSICAL" & "," & "FOLK" & "," & " ROOTS https" & ":" & "/" & "/" & "open" & "." & "spotify" & "." & "com" & "/" & "playlist" & "/" & "7gP6LVrR1OAjTI1yjTrv2h" & vbCr & vbLf & "                                                                                         https" & ":" & "/" & "/" & "www" & "." & "instagram" & "." & "com" & "/" & "benkoomen" & vbCr & vbLf & "                                                                                23665" & vbCr & vbLf & "                                                                      
                   https" & ":" & "/" & "/" & "www" & "." & "instagram" & "." & "com" & "/" & "alex" & "_" & "delany" & vbCr & vbLf & "                                                                                3" & "," & "893" & vbCr & vbLf & "                BA COOKING JAMS         Alex Delany   ROCK" & "," & " SOUL" & "," & " INDIE POP" & "," & " INDIETRONICA" & "," & " FUNK" & "," & " NEO" & "-" & "PSYCHEDELIC" & "," & " SINGER" & "/" & "SONGWRITER" & "," & "FOLK" & "-" & "POP" & "," & " POP" & "," & " RAP" & "," & " HIP HOP" & "," & " R" & "&" & "B PREVERB https" & ":" & "/" & "/" & "open" & "." & "spotify" & "." & "com" & "/" & "playlist" & "/" & "2jHbztkuPjoBO6FN3dtoL1" & vbCr & vbLf & "                    Balearic             Chris Coco   SINGER" & "/" & "SONGWRITER" & "," & " ELECTRONIC" & "," & " ROCK" & "," & " FOLK" & "," & " SOUNDTRACK" & "," & " DEEP HOUSE" & "," & " TRIP HOP" & "," & " NEOPSYCHEDELIC" & "," & " SYNTH POP" & "," & " SOUL" & "," & " DOWNTEMPO" & "," & " INDIETRONICA" & "," &
 " BOSSANOVA" & "," & " DISCO" & "," & " MPB" & "," & " SAMBA" & "," & " EXPERIMENTAL" & "," & " FOLK POP" & "," & " CHILLWAVE" & "," & " LO" & "-" & "FI" & "," & " AMBIENT" & "," & " WORLD" & vbCr & vbLf & "                                                                                          https" & ":" & "/" & "/" & "www" & "." & "instagram" & "." & "com" & "/" & "djchriscoco" & vbCr & vbLf & "                                                                                                                  https" & ":" & "/" & "/" & "open" & "." & "spotify" & "." & "com" & "/" & "playlist" & "/" & "100icvOSPBO4Mk5pYgALx4" & vbCr & vbLf & "                                                                                4" & "," & "945" & vbCr & vbLf & "                                                      INDIE POP" & "," & " INDIETRONICA" & "," & " FOLK" & "-" & "POP" & "," & " SINGER" & "/" & "SONGWRITER" & "," & " ROCK" & "," & " POP" & "," & " REGGAE" & "," & " SYNTHPOP" & "," & vbCr & vbLf & "      
            Beach Music          Kyle DeBruyn   PSYCHEDELIC" & "," & " POST" & "-" & "GRUNGE  75" & "," & "220                             https" & ":" & "/" & "/" & "open" & "." & "spotify" & "." & "com" & "/" & "playlist" & "/" & "4UiM5IjpEO4sOnxD9hork2" & vbCr & vbLf & "                                                                                3" & "," & "551" & vbCr & vbLf & "                  Beach Vibes           Caltify MX    POP" & "," & " INDIETRONICA" & "," & " DREAM POP" & "," & " R" & "&" & "B" & "," & " FUNK" & "," & " SOUL" & "," & " POP" & "," & " RAP" & "," & " HIP HOP  cesar98luna" & "@" & "hotmail" & "." & "com   https" & ":" & "/" & "/" & "open" & "." & "spotify" & "." & "com" & "/" & "playlist" & "/" & "6Y7JOodQbBZllGNsmTuFRQ" & vbCr & vbLf & "                                                                                1" & "," & "020" & vbCr & vbLf & "               Beautifully Crafted Tunes  Alec Wilson  FOLK POP" & "," & " SINGER" & "/" & "SONGWRITER" & "," & " TRIPHOP" & "," &
 " NINJA" & "," & " INDIE POP" & "," & " ELECTRONIC" & "," & " DOWNTEMPO" & "," & "INDIETRONICA" & "," & " LO" & "-" & "FI" & "," & " ROCK" & "," & " AMBIENT" & "," & " POP" & "," & " NEO" & "-" & "PSYCHEDELIC" & vbCr & vbLf & "                                                                                                                  https" & ":" & "/" & "/" & "open" & "." & "spotify" & "." & "com" & "/" & "playlist" & "/" & "17TXcS1H8xhxVuVN4rMBTy" & vbCr & vbLf & "                                                                                    https" & ":" & "/" & "/" & "www" & "." & "facebook" & "." & "com" & "/" & "AlecWilsonIndependentPlaylister" & vbCr & vbLf & "                                                                                           https" & ":" & "/" & "/" & "www" & "." & "instagram" & "." & "com" & "/" & "benwatt" & vbCr & vbLf & "                                                                                10" & "," & "492" & vbCr & vbLf & "                Ben Watt" & C
hrW(8217) & "s SpinCycle    Ben Watt      SINGER" & "/" & "SONGWRITER" & "," & " FOLK" & "-" & "POP" & "," & " INDIE POP" & "," & " PREVERB" & "," & " NEO" & "-" & "PSYCHEDELIC" & "," & " FUNK" & "," & " ROCK" & "," & "INDIETRONICA" & "," & " SOUL" & "," & " LO" & "-" & "FI" & "," & " FOLK" & "," & " HIP HOP" & "," & " CHILLWAVE" & "," & " EXPERIMENTAL" & "," & " RAP" & "," & " POP" & vbCr & vbLf & "                                                                                                                    https" & ":" & "/" & "/" & "open" & "." & "spotify" & "." & "com" & "/" & "playlist" & "/" & "0inHe5mbRJoHBtPl8dWMYg" & vbCr & vbLf & "                 Best New Music          Nialler9      INDIE ROCK" & "," & " ALTERNATIVE" & "," & " SINGER" & "/" & "SONGWRITER" & "," & " POP" & "," & " EDM" & "," & " ELECTRONIC" & "," & " INDIETRONICA   https" & ":" & "/" & "/" & "open" & "." & "spotify" & "." & "com" & "/" & "playlist" & "/" & "0sLxjSNzBJUn1iIxT1575E" & vbCr & vbLf & "                            
                                                                 newmusic" & "@" & "nialler9" & "." & "com" & vbCr & vbLf & "                                                                                5" & "," & "474" & vbCr & vbLf & "                                                                                            raiseyourhands" & "@" & "arts" & "-" & "crafts" & "." & "ca" & vbCr & vbLf & "             Best New Indie" & ":" & " A" & "&" & "C Favourites  Arts " & "&" & " Crafts  INDIE POP" & "," & " INDIETRONICA" & "," & " NEO" & "-" & "PSYCHEDELIC" & "," & " FOLK" & "-" & "POP" & "," & " CHILLWAVE" & "," & " PREVERB" & "," & " LO" & "-" & "FI" & "," & "DANCE PUNK" & "," & " NINJA" & "," & " INDIE ROCK https" & ":" & "/" & "/" & "open" & "." & "spotify" & "." & "com" & "/" & "playlist" & "/" & "0cRVHq3mj9gLhivNwv2wj8"

**DocAElstein** · 11-26-2020, 04:04 PM

Modified Sub WtchaGot_Unic_NotMuchIfYaChoppedItOff(
to create a text file output of the WotchaGot string
This is useful for large files, since cell content and Immediate Window text size is limited,

Code:

'3c) Output  WotchaGot  string to a text file
Dim FileNum2 As Long: Let FileNum2 = FreeFile(0)                                  ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName2 As String
 Let PathAndFileName2 = ThisWorkbook.Path & "\" & "WotchaGot_in_" & Replace(FlNme, ".txt", "", 1, 1, vbBinaryCompare) & ".txt" ' CHANGE path TO SUIT
 Open PathAndFileName2 For Output As #FileNum2 ' CHANGE TO SUIT  ' Will be made if not there
 Print #FileNum2, WotchaGot ' write out entire text file
 Close #FileNum2
End Sub

Share ‘WotchaGot_in_tt.txt’ : https://app.box.com/s/3hqrkgity8945tx70izjhj9e6wpaewg7
Share ‘tt_ExtraminationsRock.xls’ https://app.box.com/s/o5ka0fckmdp573tfyz9swwwir73hcnow

The output produced by the macro ( shown in worksheet “TextToTabular” ) of the uploaded file, “tt_ExtraminationsRock.xls” , is very similar to the “Sample.pdf” – I can see some discrepancies in the column for Followers This is because two numbers are completely missing from the text file ( 958 and 17145 ) –

https://i.imgur.com/q9fFtW0.jpg http://i.imgur.com/q9fFtW0.jpg https://imgur.com/q9fFtW0

**DocAElstein** · 11-26-2020, 04:05 PM

Modified Sub WtchaGot_Unic_NotMuchIfYaChoppedItOff(
to create a text file output of the WotchaGot string ( in the last post it was used to produce the text file
WotchaGot_in_tt.txt )

Code:

' https://excelfox.com/forum/showthread.php/2302-quot-What%E2%80%99s-in-a-String-quot-VBA-break-down-Loop-through-character-contents-of-a-string
' https://excelfox.com/forum/showthread.php/2302-quot-What%E2%80%99s-in-a-String-quot-VBA-break-down-Loop-through-character-contents-of-a-string?p=11015&viewfull=1#post11015
Sub WtchaGot_Unic_NotMuchIfYaChoppedItOff(ByVal strIn As String, Optional ByVal FlNme As String) '
Rem 1  ' Output "sheet hardcopies"
'1a) Worksheets     'Make Temporary Sheets, if not already there, in Current Active Workbook, for a simple list of all characters, and for pasting the string into worksheet cells
'1a)(i) Full list of characters worksheet
    If Not Evaluate("=ISREF(" & "'" & "WotchaGotInString" & "'!Z78)") Then '   ( the '  are not important here, but in general allow for a space in the worksheet name like  "Wotcha Got In String"
    Dim Wb As Workbook '                                   ' ' Dim:  ' Preparing a "Pointer" to an Initial "Blue Print" in Memory of the Object ( Pigeon Hole with a bit of paper or code lines on that can be filled in to refer to a specific Objec of this type ) . This also us to get easily at the Methods and Properties throught the applying of a period ( .Dot) ( intellisense )                     '
     Set Wb = ActiveWorkbook '  '                            Set now (to Active Workbook - one being "looked at"), so that we carefull allways referrence this so as not to go astray through Excel Guessing inplicitly not the one we want...         Set: Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed.      http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191                                '
     Wb.Worksheets.Add After:=Wb.Worksheets.Item(Worksheets.Count) 'A sheeet is added and will be Active
    Dim Ws As Worksheet '
     Set Ws = ActiveSheet 'Rather than rely on always going to the active sheet, we referr to it Explicitly so that we carefull allways referrence this so as not to go astray through Excel Guessing implicitly not the one we want...    Set: Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed.      http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191            ' Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed.      http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191
     Ws.Activate: Ws.Cells(1, 1).Activate ' ws.Activate and activating a cell sometimes seemed to overcome a strange error
     Let Ws.Name = "WotchaGotInString"
    Else ' The worksheet is already there , so I just need to set my variable to point to it
     Set Ws = ThisWorkbook.Worksheets("WotchaGotInString")
    End If
'1a(ii) Worksheet to paste out string into worksheet cells
    If Not Evaluate("=ISREF(" & "'" & "StrIn|WtchaGot" & "'!Z78)") Then
     Set Wb = ActiveWorkbook
     Wb.Worksheets.Add After:=Wb.Worksheets.Item(1)
    Dim Ws1 As Worksheet
     Set Ws1 = ActiveSheet
     Ws1.Activate: Ws1.Cells(1, 1).Activate
     Let Ws1.Name = "StrIn|WtchaGot"
    Else
     Set Ws1 = ThisWorkbook.Worksheets("StrIn|WtchaGot")
    End If
'1b) Array
Dim myLenf As Long: Let myLenf = Len(strIn)  '            ' 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
Dim arrWotchaGot() As String: ReDim arrWotchaGot(1 To myLenf + 1, 1 To 2) ' +1 for header  Array for the output 2 column list.  The type is known and the size,  but I must use this ReDim  method simply because the dim statement  Dim( , )  is complie time thing and will only take actual numbers
 Let arrWotchaGot(1, 1) = FlNme & vbLf & Format(Now, "DD MMM YYYY") & vbLf & "Lenf is   " & myLenf: Let arrWotchaGot(1, 2) = Left(strIn, 40)
Rem 2  String anylaysis
'Dim myLenf As Long: Let myLenf = Len(strIn)
Dim Cnt As Long
    For Cnt = 1 To myLenf ' ===Main Loop========================================================================
    ' Character analysis: Get at each character
    Dim Caracter As Variant ' String is probably OK.
    Let Caracter = Mid(strIn, Cnt, 1) ' '    the character in strIn at position from the left of length 1
    '2a) The character added to a single  WotchaGot  long character string to look at and possibly use in coding
    Dim WotchaGot As String ' This will be used to make a string that I can easilly see and also is in a form that I can copy and paste in a code line  required to build the full string of the complete character string
        '2a)(i) Most common characters and numbers to be displayed as "seen normally" ' -------2a)(i)--
        If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Or Caracter Like "[a-z]" Or Caracter = " " Then ' Check for normal characters
            'SirNirios
            If Not Cnt = 1 Then ' I am only intersted in next line comparing the character before, and if i did not do this the next line would error if first character was a  "normal"  character
                If Not Cnt = myLenf And (Mid(strIn, Cnt - 1, 1) Like "[A-Z]" Or Mid(strIn, Cnt - 1, 1) Like "[0-9]" Or Mid(strIn, Cnt - 1, 1) Like "[a-z]" Or Mid(strIn, Cnt - 1, 1) Like " ") Then   ' And (Mid(strIn, Cnt + 1, 1) Like "[A-Z]" Or Mid(strIn, Cnt + 1, 1) Like "[0-9]" Or Mid(strIn, Cnt + 1, 1) Like "[a-z]") Then
                 Let WotchaGot = WotchaGot & "|LinkTwoNormals|"
                Else
                End If
            Else
            End If
        Let WotchaGot = WotchaGot & """" & Caracter & """" & " & " ' This will give the sort of output that I need to write in a code line, so for example if I have a123 , this code line will be used 4 times and give like a final string for me to copy of   "a" & "1" & "2" & "3" &      I would phsically need to write in code  like  strVar = "a" & "1" & "2" & "3"   -  i could of course also write  = "a123"   but the point of this routine is to help me pick out each individual element
        Else ' Some other things that I would like to "see" normally - not "normal simple character" - or by a VBA constant, like vbCr vbLf  vbTab
         Select Case Caracter ' 2a)(ii)_1
          Case " "
           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
          Case "!"
           Let WotchaGot = WotchaGot & """" & "!" & """" & " & "
          Case "$"
           Let WotchaGot = WotchaGot & """" & "$" & """" & " & "
          Case "%"
           Let WotchaGot = WotchaGot & """" & "%" & """" & " & "
          Case "~"
           Let WotchaGot = WotchaGot & """" & "~" & """" & " & "
          Case "&"
           Let WotchaGot = WotchaGot & """" & "&" & """" & " & "
          Case "("
           Let WotchaGot = WotchaGot & """" & "(" & """" & " & "
          Case ")"
           Let WotchaGot = WotchaGot & """" & ")" & """" & " & "
          Case "/"
           Let WotchaGot = WotchaGot & """" & "/" & """" & " & "
          Case "\"
           Let WotchaGot = WotchaGot & """" & "\" & """" & " & "
          Case "="
           Let WotchaGot = WotchaGot & """" & "=" & """" & " & "
          Case "?"
           Let WotchaGot = WotchaGot & """" & "?" & """" & " & "
          Case "'"
           Let WotchaGot = WotchaGot & """" & "'" & """" & " & "
          Case "+"
           Let WotchaGot = WotchaGot & """" & "+" & """" & " & "
          Case "-"
           Let WotchaGot = WotchaGot & """" & "-" & """" & " & "
          Case "_"
           Let WotchaGot = WotchaGot & """" & "_" & """" & " & "
          Case "."
           Let WotchaGot = WotchaGot & """" & "." & """" & " & "
          Case ","
           Let WotchaGot = WotchaGot & """" & "," & """" & " & "
          Case ";"
           Let WotchaGot = WotchaGot & """" & ";" & """" & " & "
          Case ":"
           Let WotchaGot = WotchaGot & """" & ":" & """" & " & "
          Case "#"
           Let WotchaGot = WotchaGot & """" & "#" & """" & " & "
          Case "@"
           Let WotchaGot = WotchaGot & """" & "@" & """" & " & "
          Case vbCr
           Let WotchaGot = WotchaGot & "vbCr & "  ' I actuall would write manually in this case like     vbCr &
          Case vbLf
           Let WotchaGot = WotchaGot & "vbLf & "
          Case vbCrLf
           Let WotchaGot = WotchaGot & "vbCrLf & "
          Case vbNewLine
           Let WotchaGot = WotchaGot & "vbNewLine & "
          Case """"   ' This is how to get a single   "    No one is quite sure how this works.  My theory that,  is as good as any other,  is that  syntaxly   """"    or  "  """  or    """    "   are accepted.   But  in that the  """  bit is somewhat strange for VBA.   It seems to match  the first and Third " together as a  valid pair   but  the other  " in the middle of the  3 "s is also syntax OK, and does not error as    """     would  because  of the final 4th " which it syntaxly sees as a valid pair matched simultaneously as it does some similar check on the  first  and Third    as a concluding  string pair.  All is well except that  the second  "  is captured   within a   accepted  enclosing pair made up of the first and third  "   At the same time the 4th  "  is accepted as a final concluding   "   paired with the   second which it is  using but at the same time now isolated from.
           Let WotchaGot = WotchaGot & """" & """" & """" & """" & " & "                                ' The reason why  ""  ""   would not work is that    at the end of the  "" the next empty  character signalises the end of a  string pair, and only if  it saw a " would it keep checking the syntax rules which  then lead in the previous case to  the situation described above.
          Case vbTab
           Let WotchaGot = WotchaGot & "vbTab & "
          ' 2a)(iii)
            Case Else
                If AscW(Caracter) < 256 Then
                 Let WotchaGot = WotchaGot & "Chr(" & AscW(Caracter) & ")" & " & "
                Else
                 Let WotchaGot = WotchaGot & "ChrW(" & AscW(Caracter) & ")" & " & "
                End If
            'Let CaseElse = Caracter
        End Select
        End If ' End of the "normal simple character" or not ' -------2a)------Ended-----------
    '2b)  A 2 column Array for convenience of a list
     Let arrWotchaGot(Cnt + 1, 1) = Cnt & "           " & Caracter: Let arrWotchaGot(Cnt + 1, 2) = AscW(Caracter) ' +1 for header
    Next Cnt ' ========Main Loop=================================================================================
    '2c) Some tidying up
    If WotchaGot <> "" Then
     Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3) ' take off last " & "    ( 2 spaces one either side of a  & )
     Let WotchaGot = Replace(WotchaGot, """ & |LinkTwoNormals|""", "", 1, -1, vbBinaryCompare)
     ' The next bit changes like this  "Lapto" & "p"  to  "Laptop"   You might want to leave it out ti speed things up a bit
        If Len(WotchaGot) > 5 And (Mid(WotchaGot, Len(WotchaGot) - 1, 1) Like "[A-Z]" Or Mid(WotchaGot, Len(WotchaGot) - 1, 1) Like "[0-9]" Or Mid(WotchaGot, Len(WotchaGot) - 1, 1) Like "[a-z]") And (Mid(WotchaGot, Len(WotchaGot) - 7, 1) Like "[A-Z]" Or Mid(WotchaGot, Len(WotchaGot) - 7, 1) Like "[0-9]" Or Mid(WotchaGot, Len(WotchaGot) - 7, 1) Like "[a-z]") And Mid(WotchaGot, Len(WotchaGot) - 6, 5) = """" & " & " & """" Then
         Let WotchaGot = Left$(WotchaGot, Len(WotchaGot) - 7) & Mid(WotchaGot, Len(WotchaGot) - 1, 2) '  Changes like this  "Lapto" & "p"  to  "Laptop"
        Else
        End If
    Else
    End If
Rem 3 Output
'3a) String
'3a)(i)
MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot ' Hit Ctrl+g from the VB Editor to get a copyable version of the entire string
'3a)(ii)
Ws1.Activate: Ws1.Cells.Item(1, 1).Activate
Dim Lr1 As Long: Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count).End(xlUp).Row     '   http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466      Making Lr dynamic ( using rng.End(XlUp) for a single column. )
 Let Ws1.Range("A" & Lr1 + 1 & "").Value = FlNme
 Let Ws1.Range("B" & Lr1 + 1 & "").Value = strIn
 Let Ws1.Range("C" & Lr1 + 1 & "").Value = WotchaGot
 Ws1.Cells.Columns.AutoFit
'3b) List
Dim NxtClm As Long: Let NxtClm = 1 ' In conjunction with next  If  this prevents the first column beine taken as 0 for an empty worksheet
 Ws.Activate: Ws.Cells.Item(1, 1).Activate
 If Not Ws.Range("A1").Value = "" Then Let NxtClm = Ws.Cells.Item(1, Columns.Count).End(xlToLeft).Column + 1
 Let Ws.Cells.Item(1, NxtClm).Resize(UBound(arrWotchaGot(), 1), UBound(arrWotchaGot(), 2)).Value = arrWotchaGot()
 Ws.Cells.Columns.AutoFit
'3c) Output  WotchaGot  string to a text
Dim FileNum2 As Long: Let FileNum2 = FreeFile(0)                                  ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName2 As String
 Let PathAndFileName2 = ThisWorkbook.Path & "\" & "WotchaGot_in_" & Replace(FlNme, ".txt", "", 1, 1, vbBinaryCompare) & ".txt" ' CHANGE path TO SUIT
 Open PathAndFileName2 For Output As #FileNum2 ' CHANGE TO SUIT  ' Will be made if not there
 Print #FileNum2, WotchaGot ' write out entire text file
 Close #FileNum2
End Sub

**DocAElstein** · 11-26-2020, 05:37 PM

Macro for this post
https://eileenslounge.com/viewtopic....277957#p277957

Code:

Sub TextFileToTabular()    '      https://eileenslounge.com/viewtopic.php?p=277881#p277881
Rem 1 Worksheets info, (any worksheet will do to test paste out to)
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets.Item("TextToTabular")
Rem 2 Text file info
' 2a) get the text file as a long single string
Dim FileNum As Long: Let FileNum = FreeFile(1)                                  ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String
 Let PathAndFileName = ThisWorkbook.Path & Application.PathSeparator & "tt.txt"   '                                                               CHANGE TO SUIT                                                                                                         From vixer zyxw1234  : http://www.eileenslounge.com/viewtopic.php?f=30&t=34629     DF.txt https://app.box.com/s/gw941dh9v8sqhvzin3lo9rfc67fjsbic
Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
TotalFile = Space(LOF(FileNum)) '....and wot recives it has to be a string of exactly the right length
Get #FileNum, , TotalFile                                               'Debug.Print TotalFile
Close #FileNum
' Let TotalFile = Replace(TotalFile, """", "", 1, -1, vbBinaryCompare):   Debug.Print TotalFile  '   removed enclosing quotes in  rabsofty's  text file
' Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(TotalFile)
'2a)(ii)  Some simple tidying up of complete string
 Let TotalFile = Replace(TotalFile, ": http", "http", 1, -1, vbBinaryCompare) ' there are some strange   : http  which in combination with the next line will/ would  introduce an error
 Let TotalFile = Replace(TotalFile, "http", " http", 1, -1, vbBinaryCompare)  ' this ensures at least two spaces before any  link
' 2b) Split into wholes line _ splitting the text file into rows by splitting by Line Seperator
Dim arrRws() As String: Let arrRws() = Split(TotalFile, vbCr & vbLf, -1, vbBinaryCompare)
Dim RwCnt As Long: Let RwCnt = UBound(arrRws()) + 1    '  +1 is nedeed as the  Split Function  returns indicies 0 1 2 3 4 5   etc...
' 2c) We are looping all row data: Some is single element(column) entries , some is multi element(column) data.  We want to try to fill up a 6 element(column) array
Dim arrRw() As String: ReDim arrRw(1 To 6) ' we know our columns are 6 entries
' 2d) we make an array for all the final rows
Dim arrHarray() As Variant: Dim HarryCnt As Long: Let HarryCnt = 1
Dim Cnt As Long
    Do While Not Cnt = RwCnt - 1 ' We are looping all row data: Some is single element(column) entries , some is multi element(column) data
    'For Cnt = 1 To RwCnt
    ' 2c) _(A)
        Do While (arrRw(1) = "" Or arrRw(2) = "" Or arrRw(3) = "" Or arrRw(4) = "" Or arrRw(5) = "" Or arrRw(6) = "") ' we try to fill all 6 element(column) data in the array, but we try to deal with some missing
            If arrRws(Cnt) <> "" Then
             Let Cnt = Cnt + 1
              ' _(B)
                If InStr(1, Trim(arrRws(Cnt - 1)), "  ", vbBinaryCompare) = 0 Then ' this is the case of a rouge line
                  ' _(C)
                    If InStr(1, Trim(arrRws(Cnt - 1)), "@", vbBinaryCompare) <> 0 Or InStr(1, Trim(arrRws(Cnt - 1)), "https://www.instagram.com", vbBinaryCompare) <> 0 Or InStr(1, Trim(arrRws(Cnt - 1)), "https://www.facebook.com", vbBinaryCompare) <> 0 Or InStr(1, Trim(arrRws(Cnt - 1)), "http://reddit.com", vbBinaryCompare) <> 0 Then
                        If arrRw(5) <> "" Then Let Cnt = Cnt - 1: GoTo Missing
                     Let arrRw(5) = Trim(arrRws(Cnt - 1))
                   ' _(D)
                    ElseIf InStr(1, Trim(arrRws(Cnt - 1)), "https://open.spotify.com/", vbBinaryCompare) <> 0 Then
                        If arrRw(6) <> "" Then Let Cnt = Cnt - 1: GoTo Missing
                     Let arrRw(6) = Trim(arrRws(Cnt - 1))
                    ElseIf IsNumeric(Trim(arrRws(Cnt - 1))) Then
                        If arrRw(4) <> "" Then Let Cnt = Cnt - 1: GoTo Missing
                     Let arrRw(4) = Trim(arrRws(Cnt - 1))
                    ElseIf InStr(1, Trim(arrRws(Cnt - 1)), ",", vbBinaryCompare) <> 0 Then
                    Dim ExtrGenitals As String
                        If ExtrGenitals <> "" Then Let Cnt = Cnt - 1: GoTo Missing
                     Let ExtrGenitals = Trim(arrRws(Cnt - 1))
                    
                    Else
                    End If
                    
                Else ' we have a line with multiple data, assuming that such data is seperated by at least 2 spaces  "  "
                Dim DataSRw As String: Let DataSRw = arrRws(Cnt - 1)
                 Let DataSRw = LTrim(DataSRw) & "  " ' take off any preceding spaces and add a few spaces so that next  Loop  works for the last element
                Dim posTwoSpcs As Long
                    Do While DataSRw <> "" '  looping to get all data from a dataS row ----
                    Dim ClmCnt As Long: Let ClmCnt = ClmCnt + 1
                     Let posTwoSpcs = InStr(1, DataSRw, "  ", vbBinaryCompare)
                        If ClmCnt > 3 Then ' after the third entry things may be not incorrect order
                        Dim UnOrdedIndataSRw As String
                         Let UnOrdedIndataSRw = Left(DataSRw, (posTwoSpcs - 1))
                            If InStr(1, UnOrdedIndataSRw, "@", vbBinaryCompare) <> 0 Or InStr(1, UnOrdedIndataSRw, "https://www.instagram.com", vbBinaryCompare) <> 0 Or InStr(1, UnOrdedIndataSRw, "https://www.facebook.com", vbBinaryCompare) <> 0 Or InStr(1, UnOrdedIndataSRw, "http://reddit.com", vbBinaryCompare) <> 0 Then
                                If arrRw(5) <> "" Then Let Cnt = Cnt - 1: GoTo Missing
                             Let arrRw(5) = UnOrdedIndataSRw
                            ElseIf InStr(1, UnOrdedIndataSRw, "https://open.spotify.com/", vbBinaryCompare) <> 0 Then
                                If arrRw(6) <> "" Then Let Cnt = Cnt - 1: GoTo Missing
                             Let arrRw(6) = UnOrdedIndataSRw
                            Else
                                If arrRw(ClmCnt) <> "" Then Let Cnt = Cnt - 1: GoTo Missing
                             Let arrRw(ClmCnt) = Left(DataSRw, (posTwoSpcs - 1))
                            End If
                        Else
                         Let arrRw(ClmCnt) = Left(DataSRw, (posTwoSpcs - 1))
                            If ClmCnt = 3 And InStr(1, arrRw(3), " ", vbBinaryCompare) <> 0 And (InStr(1, arrRw(3), "@", vbBinaryCompare) <> 0 Or InStr(1, arrRw(3), "https://www.instagram.com", vbBinaryCompare) <> 0 Or InStr(1, arrRw(3), "https://www.facebook.com", vbBinaryCompare) <> 0 Or InStr(1, arrRw(3), "http://reddit.com", vbBinaryCompare) <> 0) Then ' We may have a problem that after the Genres data has a link added with just one space that should be the fifth column (Best Way To Contact)
                            Dim SptGenitral() As String: Let SptGenitral() = Split(arrRw(3), " ", -1, vbBinaryCompare)
                             Let arrRw(5) = SptGenitral(UBound(SptGenitral))
                             Let arrRw(3) = Replace(arrRw(3), " " & arrRw(5), "", 1, -1, vbBinaryCompare)
                             Let posTwoSpcs = InStr(1, DataSRw, "  ", vbBinaryCompare)
                            ' _(B)(i) The macro will deal with some cases of  Curator   and  Genres   only being separated by one space  This next bit may sort out if the Curator is in two words and is only seperated from the Playlist Name by 1 space
                            ElseIf InStr(1, arrRw(3), "@", vbBinaryCompare) <> 0 Or InStr(1, arrRw(3), "https://www.instagram.com", vbBinaryCompare) <> 0 Or InStr(1, arrRw(3), "https://www.facebook.com", vbBinaryCompare) <> 0 Or InStr(1, arrRw(3), "http://reddit.com", vbBinaryCompare) <> 0 Then
                             Let arrRw(5) = arrRw(3)
                             Let arrRw(3) = arrRw(2)
                            Dim Spt1a() As String: Let Spt1a() = Split(arrRw(1), " ", -1, vbBinaryCompare)
                             Let arrRw(2) = Spt1a(UBound(Spt1a()) - 1) & " " & Spt1a(UBound(Spt1a()))
                            ElseIf InStr(1, arrRw(3), "https://open.spotify.com/", vbBinaryCompare) <> 0 Then
                             Let arrRw(6) = arrRw(3)
                             Let arrRw(3) = arrRw(2)
                             Let arrRw(1) = Replace(arrRw(1), arrRw(2), "", 1, 1, vbBinaryCompare)
                            Dim Spt1b() As String: Let Spt1b() = Split(arrRw(1), " ", -1, vbBinaryCompare)
                             Let arrRw(2) = Spt1b(UBound(Spt1b()) - 1) & " " & Spt1b(UBound(Spt1b()))
                             Let arrRw(1) = Replace(arrRw(1), arrRw(2), "", 1, 1, vbBinaryCompare)
                            End If
                        End If
                     Let DataSRw = Mid(DataSRw, posTwoSpcs)
                     Let DataSRw = LTrim(DataSRw)

                    Loop                   '  looping to get all data from a dataS row ----
                End If
            Else ' case empty row
             Let Cnt = Cnt + 1   '   increase to next data row from the text file
                If Cnt = RwCnt Then GoTo Bed
            End If
        Loop ' While (arrRw(1) = "" Or arrRw(2) = "" Or arrRw(3) = "" Or arrRw(4) = "" Or arrRw(5) = "" Or arrRw(6) = "")
Missing: ' _(A)(i)   we come here if we tried to fill an already filled element, which indicates we had something missing
         Let arrRw(3) = arrRw(3) & ExtrGenitals  '  modify Genres string to include any appearing in a rogue line
        ' 2d)(ii) At this point its time to put the current completed row data into the jagged array to use late in Index
Rem 3  An array is built up by using that interesting "Index on a unjagged jagged 1Ds arrays  technique" that we first noticed here: https://eileenslounge.com/viewtopic.php?p=266691#p266691 https://eileenslounge.com/viewtopic.php?p=266727#p266727 https://www.ozgrid.com/forum/index.php?thread/1227920-slicing-a-2d-array/&postID=1239241#post1239241
        ReDim Preserve arrHarray(1 To HarryCnt)
         Let arrHarray(HarryCnt) = arrRw()
         Let HarryCnt = HarryCnt + 1
        
        ReDim arrRw(1 To 6) ' this resets (empties) the row array
         Let ClmCnt = 0
         Let ExtrGenitals = ""
    Loop ' While Not Cnt = RwCnt-1
Bed: ' This section will deal with a problem of the last row in harry being missed if it is missing some data
ReDim Preserve arrHarray(1 To HarryCnt)
 Let arrHarray(HarryCnt) = arrRw()
Rem 4  Finally the array is pasted to  worksheet                             ' use of that interesting "Index on a unjagged jagged 1Ds arrays  technique" that we first noticed here: https://eileenslounge.com/viewtopic.php?p=266691#p266691 https://eileenslounge.com/viewtopic.php?p=266727#p266727 https://www.ozgrid.com/forum/index.php?thread/1227920-slicing-a-2d-array/&postID=1239241#post1239241
Dim RngOut As Range: Set RngOut = Worksheets("TextToTabular").Range("A1:F" & UBound(arrHarray()) & "")
 Let RngOut.Value = Application.Index(arrHarray(), Evaluate("=row(1:" & UBound(arrHarray()) & ")"), Array(1, 2, 3, 4, 5, 6))
 Worksheets("TextToTabular").Columns("A:F").AutoFit
'' 4b Option to remove the  little   ...    when i click on any cell that has output there is an option numbers stored as text, convert to numbers,help on this error,ignore error,edit in formula bar,error checking options(these are the options coming)…
' Let RngOut.Value = Evaluate("=IF(" & RngOut.Address & "="""","""",IF(ISNUMBER(1*" & RngOut.Address & "),1*" & RngOut.Address & "," & RngOut.Address & "))")   '    http://www.eileenslounge.com/viewtopic.php?p=272704#p272704
End Sub

**DocAElstein** · 11-27-2020, 12:33 PM

In support of this Thread
https://www.ozgrid.com/forum/index.p...23#post1241623

Code:

"-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & " " & vbCr & vbLf & "This is a  report for last week " & vbCr & vbLf & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & " " & vbCr & vbLf & " " & vbCr & vbLf & "Date" & "," & "RunbookBCompletionTime " & vbCr & vbLf & "20201116" & "," & "05" & ":" & "44 AM" & vbCr & vbLf & "20201117" & "," & "05" & ":" & "47 AM" & vbCr & vbLf & "20201118" & "," & "05" & ":" & "39 AM" & vbCr & vbLf & "20201119" & "," & "06" & ":" & "10 AM" & vbCr & vbLf & "20201120" & "," & "05" & ":" & "49 AM" & vbCr & vbLf & "20201121" & "," & "07" & ":" & "13 AM" & vbCr & vbLf & "20201122" & "," & "06" & ":" & "01 AM" & vbCr & vbLf & " " & vbCr & vbLf & "Date" & "," & "ActiveProducts " & vbCr & vbLf & "20201116" & "," & "24" & vbCr & vbLf & "20201117" & "," & "244" & vbCr & vbLf & "20201118" & "," & "245 " & vbCr & vbLf & "20201119" & "," & "24 " & vbCr & vbLf & "20201120" & "," & "249 " & vbCr & vbLf & "20201121" & "," & "250 " & vbCr & vbLf & "20201122" & "," & "250 " & vbCr & vbLf & " " & vbCr & vbLf & "Date" & "," & "ActiveSKUs  " & vbCr & vbLf & "20201116" & "," & "137" & vbCr & vbLf & "20201117" & "," & "13" & vbCr & vbLf & "20201118" & "," & "13" & vbCr & vbLf & "20201119" & "," & "1368" & vbCr & vbLf & "20201120" & "," & "13" & vbCr & vbLf & "20201121" & "," & "1381" & vbCr & vbLf & "20201122" & "," & "13" & vbCr & vbLf & " " & vbCr & vbLf & "Date" & "," & "CompletedOrderCount " & vbCr & vbLf & "20201116" & "," & "24" & vbCr & vbLf & "20201117" & "," & "24" & vbCr & vbLf & "20201118" & "," & "3" & vbCr & vbLf & "20201119" & "," & "24" & vbCr & vbLf & "20201120" & "," & "63" & vbCr & vbLf & "20201121" & "," & "69" & vbCr & vbLf & "20201122" & "," & "8" & vbCr & vbLf & "20201123" & "," & "9" & vbCr & vbLf & " " & vbCr & vbLf & "Date" & "," & "PendingOrderCount " & vbCr & vbLf & "20201116" & "," & "18" & vbCr & vbLf & "20201117" & "," & "5405" & vbCr & vbLf & "20201118" & "," & "6114" & vbCr & vbLf & "20201119" & "," & "6" & vbCr & vbLf & "20201120" & "," & "6482" & vbCr & vbLf & "20201121" & "," & "74" & vbCr & vbLf & "20201122" & "," & "128" & vbCr & vbLf & "20201123" & "," & "4" & vbCr & vbLf & "  " & vbCr & vbLf

Code:

"-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & " " & vbCr & vbLf
"This is a  report for last week " & vbCr & vbLf
"-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & " " & vbCr & vbLf
" " & vbCr & vbLf
"Date" & "," & "RunbookBCompletionTime " & vbCr & vbLf
"20201116" & "," & "05" & ":" & "44 AM" & vbCr & vbLf
"20201117" & "," & "05" & ":" & "47 AM" & vbCr & vbLf
"20201118" & "," & "05" & ":" & "39 AM" & vbCr & vbLf
"20201119" & "," & "06" & ":" & "10 AM" & vbCr & vbLf
"20201120" & "," & "05" & ":" & "49 AM" & vbCr & vbLf
"20201121" & "," & "07" & ":" & "13 AM" & vbCr & vbLf
"20201122" & "," & "06" & ":" & "01 AM" & vbCr & vbLf
" " & vbCr & vbLf
"Date" & "," & "ActiveProducts " & vbCr & vbLf
"20201116" & "," & "24" & vbCr & vbLf
"20201117" & "," & "244" & vbCr & vbLf
"20201118" & "," & "245 " & vbCr & vbLf
"20201119" & "," & "24 " & vbCr & vbLf
"20201120" & "," & "249 " & vbCr & vbLf
"20201121" & "," & "250 " & vbCr & vbLf
"20201122" & "," & "250 " & vbCr & vbLf
" " & vbCr & vbLf
"Date" & "," & "ActiveSKUs  " & vbCr & vbLf
"20201116" & "," & "137" & vbCr & vbLf
"20201117" & "," & "13" & vbCr & vbLf
"20201118" & "," & "13" & vbCr & vbLf
"20201119" & "," & "1368" & vbCr & vbLf
"20201120" & "," & "13" & vbCr & vbLf
"20201121" & "," & "1381" & vbCr & vbLf
"20201122" & "," & "13" & vbCr & vbLf
" " & vbCr & vbLf
"Date" & "," & "CompletedOrderCount " & vbCr & vbLf
"20201116" & "," & "24" & vbCr & vbLf
"20201117" & "," & "24" & vbCr & vbLf
"20201118" & "," & "3" & vbCr & vbLf
"20201119" & "," & "24" & vbCr & vbLf
"20201120" & "," & "63" & vbCr & vbLf
"20201121" & "," & "69" & vbCr & vbLf
"20201122" & "," & "8" & vbCr & vbLf
"20201123" & "," & "9" & vbCr & vbLf
" " & vbCr & vbLf
"Date" & "," & "PendingOrderCount " & vbCr & vbLf
"20201116" & "," & "18" & vbCr & vbLf
"20201117" & "," & "5405" & vbCr & vbLf
"20201118" & "," & "6114" & vbCr & vbLf
"20201119" & "," & "6" & vbCr & vbLf
"20201120" & "," & "6482" & vbCr & vbLf
"20201121" & "," & "74" & vbCr & vbLf
"20201122" & "," & "128" & vbCr & vbLf
"20201123" & "," & "4" & vbCr & vbLf
"  " & vbCr & vbLf

Code:

0 "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & " " & vbCr & vbLf
1 "This is a  report for last week " & vbCr & vbLf
2 "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & "-" & " " & vbCr & vbLf
3 " " & vbCr & vbLf
4 "Date" & "," & "RunbookBCompletionTime " & vbCr & vbLf
5 "20201116" & "," & "05" & ":" & "44 AM" & vbCr & vbLf
6 "20201117" & "," & "05" & ":" & "47 AM" & vbCr & vbLf
7 "20201118" & "," & "05" & ":" & "39 AM" & vbCr & vbLf
8 "20201119" & "," & "06" & ":" & "10 AM" & vbCr & vbLf
9 "20201120" & "," & "05" & ":" & "49 AM" & vbCr & vbLf
10 "20201121" & "," & "07" & ":" & "13 AM" & vbCr & vbLf
11 "20201122" & "," & "06" & ":" & "01 AM" & vbCr & vbLf
12 " " & vbCr & vbLf
13 "Date" & "," & "ActiveProducts " & vbCr & vbLf
14 "20201116" & "," & "24" & vbCr & vbLf
15 "20201117" & "," & "244" & vbCr & vbLf
16 "20201118" & "," & "245 " & vbCr & vbLf
17 "20201119" & "," & "24 " & vbCr & vbLf
18 "20201120" & "," & "249 " & vbCr & vbLf
19 "20201121" & "," & "250 " & vbCr & vbLf
20 "20201122" & "," & "250 " & vbCr & vbLf
21 " " & vbCr & vbLf
22 "Date" & "," & "ActiveSKUs  " & vbCr & vbLf
23 "20201116" & "," & "137" & vbCr & vbLf
24 "20201117" & "," & "13" & vbCr & vbLf
25 "20201118" & "," & "13" & vbCr & vbLf
26 "20201119" & "," & "1368" & vbCr & vbLf
27 "20201120" & "," & "13" & vbCr & vbLf
28 "20201121" & "," & "1381" & vbCr & vbLf
29 "20201122" & "," & "13" & vbCr & vbLf
30 " " & vbCr & vbLf
31 "Date" & "," & "CompletedOrderCount " & vbCr & vbLf
32 "20201116" & "," & "24" & vbCr & vbLf
33 "20201117" & "," & "24" & vbCr & vbLf
34 "20201118" & "," & "3" & vbCr & vbLf
35 "20201119" & "," & "24" & vbCr & vbLf
36 "20201120" & "," & "63" & vbCr & vbLf
37 "20201121" & "," & "69" & vbCr & vbLf
38 "20201122" & "," & "8" & vbCr & vbLf
39 "20201123" & "," & "9" & vbCr & vbLf
40 " " & vbCr & vbLf
41 "Date" & "," & "PendingOrderCount " & vbCr & vbLf
42 "20201116" & "," & "18" & vbCr & vbLf
43 "20201117" & "," & "5405" & vbCr & vbLf
44 "20201118" & "," & "6114" & vbCr & vbLf
45 "20201119" & "," & "6" & vbCr & vbLf
46 "20201120" & "," & "6482" & vbCr & vbLf
47 "20201121" & "," & "74" & vbCr & vbLf
48 "20201122" & "," & "128" & vbCr & vbLf
49 "20201123" & "," & "4" & vbCr & vbLf
50 "  " & vbCr & vbLf

http://i.imgur.com/JouNd9P.jpg

Code:

Sub LookInAndImportTextStringSample()
Dim FileNum As Long: Let FileNum = FreeFile(1)                                                                               ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String, FlNme As String
 Let FlNme = "Sample.txt"
 Let PathAndFileName = ThisWorkbook.Path & "\" & FlNme
Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
 Let TotalFile = Space(LOF(FileNum)) '....and wot recives it hs to be a string of exactly the right length
Get #FileNum, , TotalFile
Close #FileNum
'' What is in this string?
'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(TotalFile, FlNme)
' We now have the entire text file as a long string, it looks like the conventional   vbCr and vbLf  are used as line seperators,
Dim arrRws() As String: Let arrRws() = Split(TotalFile, vbCr & vbLf, -1, vbBinaryCompare)
'
' Make an array for the output
Dim arrOut() As Variant: Let arrOut() = ThisWorkbook.Worksheets("Sheet1").Range("B4:AC10").Value
' An array for the Headers in Excel file
Dim ExHdrs() As Variant: Let ExHdrs() = ThisWorkbook.Worksheets("Sheet1").Range("A4:A10").Value
Dim Cnt As Long
    Do While Cnt - 1 < UBound(arrRws)
     Let Cnt = Cnt + 1 ' For next line
    Dim Lne As String: Let Lne = arrRws(Cnt - 1) ' The line text
        If Left(Lne, 4) = "Date" Then ' we have arived at a chunk of data
        Dim Hdr As String: Let Hdr = Mid(Lne, (InStr(1, Lne, ",", vbBinaryCompare) + 1)) ' this picks out the header in the text string line
         Let Hdr = Trim(Hdr) ' the text sample data has an extra space at the end, so this takes it off
        Dim ExHdrRw As Variant: Let ExHdrRw = Application.Match(Hdr, ExHdrs(), 0) ' this will be the first dimension ( "row" ) where the data should go in the output array
            If IsError(ExHdrRw) Then ' Application.match will give an Excel error if it does not find the matching heading in the Excel worksheet column  "A4:A10"
             MsgBox prompt:="The header, """ & Hdr & """ , is not in the Excel file"
             Exit Sub
            Else ' we have a valid header
                Do While Trim(arrRws(Cnt)) <> "" And Cnt - 1 < UBound(arrRws) '   ( I am using  Trim( )  because some of the "empty" lines actually had a space in them )
                 Let Cnt = Cnt + 1 ' For next line
                 Let Lne = arrRws(Cnt - 1) ' The line text
                    If Left(Lne, 2) = "20" Then ' check we have a dtae entry in the line
                    Dim Dey As Long: Let Dey = Mid(Lne, 7, 2) ' pick out the day
                    ' We now have the day and the Header row, so we can go about picking out the data and putting the data ijn the corr4ect place in the output array
                    Dim Tme As String: Let Tme = Mid(Lne, InStr(1, Lne, ",", vbBinaryCompare) + 1) ' this picks out the time shown after the   ","
                        Let arrOut(ExHdrRw, Dey) = Tme
                    Else
                    ' we do not have a date enty in the line
                    End If
                Loop ' While arrRws(Cnt) <> "" And Cnt - 1 < UBound(arrRws)
            End If
        Else
        ' Its a sutuation to keep going down looking for a  "Date"  in the line text
        End If
    Loop ' While Cnt < ubound(arrRws)
'
' Finally paste the output array to the worksheet
Let ThisWorkbook.Worksheets("Sheet1").Range("B4:AC10").Value = arrOut()
End Sub

results after running macro , Sub LookInAndImportTextStringSample()

_Row\^Col	Q	R	S	T	U	V	W	X	Y
1
2	16	17	18	19	20	21			27
3	M	T	W	Th	F	S	Su	M	T
4	5:44 AM	5:47 AM	5:39 AM	6:10 AM	5:49 AM	7:13 AM	6:01 AM	4
5	24	244	245	24	249	250	250
6	137	13	13	1368	13	1381	13
7
8
9	24	24	3	24	63	69	8	9
10	18	5405	6114	6	6482	74	128	4
11

See also next post for more detailed results:

**DocAElstein** · 11-27-2020, 12:33 PM

In support of this Thread
https://www.ozgrid.com/forum/index.p...23#post1241623

Before
_____ Workbook: Sample excel file.xls ( Using Excel 2007 32 bit )

_Row\^Col	A	B	P	Q	R	S	T	U	V	W	X	Y
2			15	16	17	18	19	20	21			27
3		SLA	Su	M	T	W	Th	F	S	Su	M	T
4	RunbookBCompletionTime	6:00AM
5	ActiveProducts	N/A
6	ActiveSKUs	N/A
7	Pending	N/A
8	Completed	N/A
9	CompletedOrderCount	N/A
10	PendingOrderCount	N/A
11
12
13	Active
14

Worksheet: Sheet1
http://i.imgur.com/jrBBlXT.jpg

text file: Sample.txt

Code:

---------------------------------------------------- 
This is a  report for last week 
---------------------------------------------------- 
 
Date,RunbookBCompletionTime 
20201116,05:44 AM
20201117,05:47 AM
20201118,05:39 AM
20201119,06:10 AM
20201120,05:49 AM
20201121,07:13 AM
20201122,06:01 AM
 
Date,ActiveProducts 
20201116,24
20201117,244
20201118,245 
20201119,24 
20201120,249 
20201121,250 
20201122,250 
 
Date,ActiveSKUs  
20201116,137
20201117,13
20201118,13
20201119,1368
20201120,13
20201121,1381
20201122,13
 
Date,CompletedOrderCount 
20201116,24
20201117,24
20201118,3
20201119,24
20201120,63
20201121,69
20201122,8
20201123,9
 
Date,PendingOrderCount 
20201116,18
20201117,5405
20201118,6114
20201119,6
20201120,6482
20201121,74
20201122,128
20201123,4

After runningSub LookInAndImportTextStringSample()
https://i.imgur.com/0m881xs.jpg

_____ Workbook: Sample excel file.xls ( Using Excel 2007 32 bit )

_Row\^Col	P	Q	R	S	T	U	V	W	X	Y
2	15	16	17	18	19	20	21			27
3	Su	M	T	W	Th	F	S	Su	M	T
4		05:44	05:47	05:39	06:10	05:49	07:13	06:01
5		24	244	245	24	249	250	250
6		137	13	13	1368	13	1381	13
7
8
9		24	24	3	24	63	69	8	9
10		18	5405	6114	6	6482	74	128	4
11
12