Page 2 of 12 FirstFirst 1234 ... LastLast
Results 11 to 20 of 115

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

Hybrid View

Previous Post Previous Post   Next Post Next Post
  1. #1
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,451
    Rep Power
    10
    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"

  2. #2
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,451
    Rep Power
    10
    Post for later use to keep order, and to get URL now for an index page in Blog post
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  3. #3
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,451
    Rep Power
    10
    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
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  4. #4
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,451
    Rep Power
    10
    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
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  5. #5
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,451
    Rep Power
    10
    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



    Last edited by DocAElstein; 11-26-2020 at 04:20 PM.
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  6. #6
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,451
    Rep Power
    10
    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
    Last edited by DocAElstein; 11-26-2020 at 08:55 PM.
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  7. #7
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,451
    Rep Power
    10
    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
    Last edited by DocAElstein; 11-26-2020 at 08:47 PM.
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  8. #8
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,451
    Rep Power
    10
    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
    Worksheet: Sheet1






    Share ‘Sample excel file.xls’ : https://app.box.com/s/hw4uxwjlm8t8zty17kc07xihq0bfhifs
    Share ‘Sample excel file.xlsm’ : https://app.box.com/s/ccmk5sgazueejb4dc0eqw6yex0zhjar2
    Last edited by DocAElstein; 12-01-2020 at 01:29 PM.

  9. #9
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,451
    Rep Power
    10
    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"
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  10. #10
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,451
    Rep Power
    10
    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:
    Last edited by DocAElstein; 12-01-2020 at 01:15 PM.
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

Similar Threads

  1. Replies: 109
    Last Post: 03-29-2024, 07:01 PM
  2. Replies: 4
    Last Post: 01-30-2022, 04:05 PM
  3. Replies: 29
    Last Post: 06-09-2020, 06:00 PM
  4. Notes tests. Excel VBA Folder File Search
    By DocAElstein in forum Test Area
    Replies: 39
    Last Post: 03-20-2018, 04:09 PM
  5. Collate Data from csv files to excel sheet
    By dhiraj.ch185 in forum Excel Help
    Replies: 16
    Last Post: 03-06-2012, 07:37 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •