-
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
-
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"
-
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
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwplzlpYpmRqjGZem14AaABAg. 9hrvbYRwXvg9ht4b7z00X0
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgyOGlCElBSbfPIzerF4AaABAg. 9hrehNPPnBu9ht4us7TtPr
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwHjKXf3ELkU4u4j254AaABAg. 9hr503K8PDg9ht5mfLcgpR
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw1-OyZiDDxCHM2Rmp4AaABAg.9hqzs_MlQu-9ht5xNvQueN
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9htG01cKBzX
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw6UrV69zpeKvLOeOV4AaABAg. 9ht16tzryC49htJ6TpIOXR
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwMKwGZpDjv7vi7pCx4AaABAg
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw6UrV69zpeKvLOeOV4AaABAg. 9ht16tzryC49htOKs4jh3M
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgxVW-am20rQ5GFuJ9F4AaABAg
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugygb0YiLOI7fG1zQSx4AaABAg
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugygb0YiLOI7fG1zQSx4AaABAg. 9htWqRrSIfP9i-fyT84gqd
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugygb0YiLOI7fG1zQSx4AaABAg. 9htWqRrSIfP9i-kIDl-3C9
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9i57J9GEOUB
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9i58MGeM8Lg
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9i59prk5atY
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwaWs6XDXdQybNb8tZ4AaABAg. 9i5yTldIQBn9i7NB1gjyBk
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgxV9eNHvztLfFBGsvZ4AaABAg. 9i5jEuidRs99i7NUtNNy1v
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugx2zSXUtmLBSDoNWph4AaABAg. 9i3IA0y4fqp9i7NySrZamd
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9i7Qs8kxEqH
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9i7TqGQYqTz
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAJSNws8Zz
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAJvZ6kmlx
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAK0g1dU7i
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAKCDqNmnF
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAKHVSTGHy
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAKSBKPcJ6
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAKgL6lrcT
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAKlts8hKZ
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAKrX7UPP0
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAL5MSjWpA
-
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
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwplzlpYpmRqjGZem14AaABAg. 9hrvbYRwXvg9ht4b7z00X0
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgyOGlCElBSbfPIzerF4AaABAg. 9hrehNPPnBu9ht4us7TtPr
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwHjKXf3ELkU4u4j254AaABAg. 9hr503K8PDg9ht5mfLcgpR
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw1-OyZiDDxCHM2Rmp4AaABAg.9hqzs_MlQu-9ht5xNvQueN
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9htG01cKBzX
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw6UrV69zpeKvLOeOV4AaABAg. 9ht16tzryC49htJ6TpIOXR
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwMKwGZpDjv7vi7pCx4AaABAg
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw6UrV69zpeKvLOeOV4AaABAg. 9ht16tzryC49htOKs4jh3M
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgxVW-am20rQ5GFuJ9F4AaABAg
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugygb0YiLOI7fG1zQSx4AaABAg
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugygb0YiLOI7fG1zQSx4AaABAg. 9htWqRrSIfP9i-fyT84gqd
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugygb0YiLOI7fG1zQSx4AaABAg. 9htWqRrSIfP9i-kIDl-3C9
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9i57J9GEOUB
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9i58MGeM8Lg
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9i59prk5atY
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwaWs6XDXdQybNb8tZ4AaABAg. 9i5yTldIQBn9i7NB1gjyBk
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgxV9eNHvztLfFBGsvZ4AaABAg. 9i5jEuidRs99i7NUtNNy1v
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugx2zSXUtmLBSDoNWph4AaABAg. 9i3IA0y4fqp9i7NySrZamd
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9i7Qs8kxEqH
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9i7TqGQYqTz
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAJSNws8Zz
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAJvZ6kmlx
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAK0g1dU7i
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAKCDqNmnF
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAKHVSTGHy
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAKSBKPcJ6
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAKgL6lrcT
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAKlts8hKZ
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAKrX7UPP0
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAL5MSjWpA
-
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"
-
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
https://i.imgur.com/q9fFtW0.jpg
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg. 9h5lFRmix1R9h78GftO_iE
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h77HSGDH4A
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h76fafzcEJ
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h759YIjlaG
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h74pjGcbEq
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgzJJUDVv2Mb6YGkPYh4AaABAg. 9h5uPRbWIZl9h7165DZdjg
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
-
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
-
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
-
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
https://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:
-
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 https://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 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
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=UgxsozCmRd3RAmIPO5B4AaABAg. 9fxrOrrvTln9g9wr8mv2CS
https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=Ugw6zxOMtNCfmdllKQl4AaABAg
https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=UgyT1lo2YMUyZ50bLeR4AaABAg. 9fz3_oaiUeK9g96yGbAX4t
https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=Ugx5d-LrmoMM_hsJK2N4AaABAg.9fyL20jCtOI9g7pczEpcTz
https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=UgyT1lo2YMUyZ50bLeR4AaABAg. 9fz3_oaiUeK9g7lhoX-ar5
https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=Ugx5d-LrmoMM_hsJK2N4AaABAg.9fyL20jCtOI9gD0AA-sfpl
https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=Ugx5d-LrmoMM_hsJK2N4AaABAg.9fyL20jCtOI9gECpsAVGbh
https://www.youtube.com/watch?v=U76ZRIzBhOA&lc=Ugw6zxOMtNCfmdllKQl4AaABAg. 9g9wJCunNRa9gJGhDZ4RI2
https://www.youtube.com/watch?v=Sh1kZD7EVj0&lc=Ugz-pow-E8FDG8gFZ4l4AaABAg.9f8Bng22e5d9f8hoJGZY-5
https://www.youtube.com/watch?v=Sh1kZD7EVj0&lc=Ugxev2gQt7BKZ0WYMfh4AaABAg. 9f6hAjkC0ct9f8jleOui-u
https://www.youtube.com/watch?v=Sh1kZD7EVj0&lc=Ugxg9iT7MPWGBWruIzR4AaABAg
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA