VBA/Macro to create lists in notepad

[cgreene87]

Hi all,

I was wondering if the following query is even possible, I'm not certain.

I need to take the numbers on a spreadsheet in column A and generate a notepad file for each of the (price points column B) with the all corresponding numbers per price point saved into a notepad file (.txt) (one notepad file for all the numbers at 2.99, one notepad file for all the numbers at 3.99 etc). I've been copying and pasting these numbers into notepad but it is a laborious task and leaves room for error.

Many thanks if you are able to assist.

Best,

Craig

 

[snb_]

You can find a file containing the data and the code in this file:

http://www.snb-vba.eu/bestanden/__split_snb_002.xlsm

Things might be different because of international settings.
Please send your feedback in which line the code errors out if it does.

 

[DocAElstein]

You can find a file containing the data and the code in this file:

http://www.snb-vba.eu/bestanden/__split_snb_002.xlsm

Things might be different because of international settings.
Please send your feedback in which line the code errors out if it does.

Hi snb.
. Thank you very much for the file and extra info…..
. I have tried both the code in that file as well as the original code you posted which I have copied into sheet1 module alongside the new code.

. Your original code crashes here

[COLOR=#000000]Sub M_snbOriginalAlan()
    ActiveSheet.Cells(1).CurrentRegion.Resize(, 2).Copy
 
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
       .GetFromClipboard
       sn = Split(.GetText, vbCrLf)
    End With
   
    With CreateObject("scripting.filesystemobject")
      Do Until UBound(sn) = -1
    [/COLOR][COLOR=#ff0000]    c00 = Split(sn(0), ",")(1)[/COLOR][COLOR=#000000]
        .createtextfile("C:\Users\Elston\Desktop\cgreene87TextFiles\PP Output" & c00 & ".csv").write = Join(Filter(sn, c00), vbCrLf)
        sn = Filter(sn, c00, False)
      Loop
    End With
End Sub[/COLOR]

.. and gives an error in German which roughly translated says “Runtime error ‘9’: Index out of valid Ranges”


. the new code you sent gets past that point and crashes at the next line here:

Sub M_snbAlan()
    ActiveSheet.Cells(1).CurrentRegion.Resize(, 2).Copy
 
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
       .GetFromClipboard
       sn = Split(.GetText, vbCrLf)
    End With
   
    With CreateObject("scripting.filesystemobject")
      Do Until UBound(sn) = -1
     
        c00 = Split(sn(0), vbTab)(1)            ' you might have to change the splitting separator, based on international settings
        [COLOR=#ff0000].createtextfile("C:\Users\Elston\Desktop\cgreene87TextFiles\PP Output" & c00 & ".csy").write = Join(Filter(sn, c00), vbCrLf)[/COLOR]
        sn = Filter(sn, c00, False)
      Loop
    End With
End Sub 'M_snbAlan()

.. and gives an error in German which roughly translated says “Runtime error 438: Object does not support this property or Method.

Note:
.1 I get the same results with or without the Microsoft Scripting Runtime Reference box ticked

.2 In both codes sn becomes a one dimesional array looking like this (as shown in the Watch window):

"ItemPrice"
"1301443282.99"
"1302965752.99"
…..
Etc……
. But I do note that if I copy and paste these values from the watch window to here I get

"Item Price"
"130144328 2.99"
"130296575 2.99"
…..
Etc……
. 3 In the new code c00 becomes a string "Price"

. 4 I do not have too much experience with Microsoft scripting runtime and have never used it to create a text file. But in case it helps in seeing any obvious syntax differences here are a couple of codes I obtained and modified, or were give to me in MrExcel threads that used Microsoft scripting runtime. Both have worked well up until now
(One reads a text file and the other uses the Dictionary thing)



Thanks again for your help, I appreciate it
Alan





………………………………………

[color=green]'[/color]
[color=darkblue]Sub[/color] ImportapoAlan()
 
[color=green]' using the Object FileSystemObject from Microsoft's Scripting library.[/color]
[color=green]' recommended (early binding) initially in Tools>>References>>then check Microsoft Scripting Runtime Library[/color]
[color=green]' So we have Scripting (Runtime) library available[/color]
[color=green]' u.a. in there is the class FileSystemObject (FSO) . That allow access to the host computer's file system, or rather "sort of being able to use the old DOS like comannds"[/color]
[color=green]' Typically we start start by creating an instance of the FileSystem[color=darkblue]Object[/color], ours we want for text reading (but we get all the properties and methods by creating an instance of that claArraySplitStreamString. Syntax fo that is:[/color]
[color=darkblue]Dim[/color] objFilepathSOtxtRead [color=darkblue]As[/color] Object
[color=darkblue]Set[/color] objFilepathSOtxtRead = Create[color=darkblue]Object[/color]("Scripting.FileSystemObject")
   
    [color=darkblue]Dim[/color] objFilepath [color=darkblue]As[/color] Object [color=green]' the given file path is in fact an object![/color]
   
    [color=darkblue]Dim[/color] StreamString [color=darkblue]As[/color] String, ArraySplitStream[color=darkblue]String[/color] [color=green]'The got stream comes out as a (very) long string, that split (ArraySplitStream[color=darkblue]String[/color]) then become an Array[/color]
   
    [color=darkblue]Dim[/color] RowNumberinFinalArray [color=darkblue]As[/color] [color=darkblue]Byte[/color], ColumnNumberinFinalArray [color=darkblue]As[/color] [color=darkblue]Byte[/color] [color=green]'Limit initially sizes to 255[/color]
    [color=darkblue]Dim[/color] x [color=green]' No idea????[/color]
    [color=darkblue]Dim[/color] TempArrayForRowSplitinColumn 'Becomes Array by Split Method
   
    [color=darkblue]Dim[/color] y() [color=darkblue]As[/color] String [color=green]' The final Array looking as we want in Excel.[/color]
   
    [color=darkblue]Dim[/color] strFile [color=darkblue]As[/color] String
    [color=darkblue]Let[/color] strFile = Application.GetOpenFilename("CSV Files,*.txt") [color=green]'Get Dialogue box for opening Files[/color]
    [color=darkblue]If[/color] strFile = "False" [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
   
    [color=darkblue]Dim[/color] FinalShtRange [color=darkblue]As[/color] Range [color=green]'Final range in Spreadsheet.[/color]
   
[color=green]'..from apo..  ArraySplitStreamString = Split(CreateObject("scripting.filesystemobject").getfile(strFile).openastextstream.readall, vbCrLf)[/color]
 [color=green]'....expanded by me..!!!!:-[/color]
    [color=darkblue]Set[/color] objFilepath = objFilepathSOtxtRead.getfile(strFile)     [color=green]'Looks like a sgring but is actually an object[/color]
    StreamString = objFilepath.openastextstream.readall [color=green]' returns long string for entire File[/color]
    ArraySplitStreamString = Split(StreamString, vbCrLf) [color=green]'Split long string into rows looking similar to oroginal text Files[/color]
    [color=darkblue]ReDim[/color] y(1 [color=darkblue]To[/color] [color=darkblue]UBound[/color](ArraySplitStreamString) + 1, 1 [color=darkblue]To[/color] 1) [color=green]' (re)Set size to 1 column of row number equal to the line number. Must do this as  further ReDim only allows 1 index to change[/color]
      [color=darkblue]For[/color] RowNumberinFinalArray = 1 [color=darkblue]To[/color] [color=darkblue]UBound[/color](ArraySplitStreamString) + 1 [color=green]'For each row....  ( .From 1 to Array index+1(+1 because Array starts at 0)[/color]
        TempArrayForRowSplitinColumn = Split(ArraySplitStreamString(RowNumberinFinalArray - 1), ",")  [color=green]' -1 to get back to Array index convention[/color]
        [color=darkblue]ReDim[/color] [color=darkblue]Preserve[/color] y(1 [color=darkblue]To[/color] [color=darkblue]UBound[/color](ArraySplitStreamString) + 1, 1 [color=darkblue]To[/color] [color=darkblue]UBound[/color](TempArrayForRowSplitinColumn)) [color=green]' change column size to number of  split columns[/color]
          [color=darkblue]For[/color] ColumnNumberinFinalArray = 1 [color=darkblue]To[/color] [color=darkblue]UBound[/color](TempArrayForRowSplitinColumn) [color=green]'....go througth each column[/color]
          y(RowNumberinFinalArray, ColumnNumberinFinalArray) = TempArrayForRowSplitinColumn(ColumnNumberinFinalArray - 1) [color=green]'Most importan doing line: Give final array the value in appropriate place.[/color]
          [color=darkblue]Next[/color] ColumnNumberinFinalArray [color=green]' going along each column until all done then....[/color]
      [color=darkblue]Next[/color] RowNumberinFinalArray [color=green]' start again for the next Row[/color]
    [color=darkblue]Set[/color] FinalShtRange = Sheets("apoLCS").Cells(1, 1).Resize(UBound(y, 1), UBound(y, 2)) [color=green]'Set Final Range to size of final Array[/color]
    [color=darkblue]Let[/color] FinalShtRange.Value = y [color=green]'copy Array to final range (will only work if sizes are identical)[/color]
    [color=darkblue]With[/color] Sheets("apoLCS").UsedRange
        x = .Replace("""", "", xlPart) [color=green]'Not sure if , What , Why or how that is doung anything. Appears not to be necerssary[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color] [color=green]'ImportapoAlan()[/color]
[color=darkblue]Sub[/color] Importapo()

[color=green]'[/color]
[color=darkblue]Sub[/color] Test_5JerryScriptedRuntimeDictionary()
 
[color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]GoTo[/color] TheEnd
Application.ScreenUpdating = [color=darkblue]False[/color]
Application.Calculation = xlCalculationManual
[color=green]' Code 4 Jerry Sullivan Scripted a Runtime "Dictionary" of my File with Entries and used it to "Look up" wot to be put in the main File.[/color]
[color=green]'--Reads lookup table into dictionary[/color]
[color=green]'  Reads lookup values into array then[/color]
[color=green]'  stores results of dictionary lookups in array[/color]
[color=green]'  then transfers array values to cells in one write[/color]
 
 
[color=green]'--requires library reference to MS Scripting Runtime (Early Binding)- "Belt"[/color]
[color=green]'        Tools>>References>>scroll down and check the box next to Microsoft Scripting Runtime[/color]
[color=green]'  ..Or crashes at next line.....[/color]
[color=green]' Dim dicLookupTable As Scripting.Dictionary 'Data held with a unique "Key" or Part Number.[/color]
[color=green]' Set dicLookupTable = New Scripting.Dictionary[/color]
[color=green]' The next two lines are an alternative called Late binding. Braces[/color]
[color=darkblue]Dim[/color] dicLookupTable [color=darkblue]As[/color] [color=darkblue]Object[/color]
[color=darkblue]Set[/color] dicLookupTable = CreateObject("Scripting.Dictionary")
  dicLookupTable.CompareMode = vbTextCompare
 
 
 
 
 [color=darkblue]Dim[/color] sKey [color=darkblue]As[/color] [color=darkblue]String[/color] [color=green]'Tempory string for part number or "key" - In my case the product name[/color]
 [color=green]'.  Very naively the key can be "pictured" as the first Name column in a master Array.[/color]
 [color=green]'.  But this contradicts the basic principal and advantage of the "Scripting Dictionary method". -[/color]
[color=green]'.  A Dictionary in VBA is a collectionobject: you can store all kinds of things in it.[/color]
[color=green]'.  Every item in a Dictionary gets its own unique key, a very important characteristic.[/color]
[color=green]'.  Instead of manipulating data in an Excel-worksheet etc, you can do that in memory, easy and quick since they are temporarily stored there.[/color]
[color=green]'.  So it should speed up code considerably.[/color]
 [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color]
 [color=darkblue]Dim[/color] vLookupTable() [color=darkblue]As[/color] [color=darkblue]Variant[/color] [color=green]'Effectively Spreadsheet Pro as Array[/color]
 [color=darkblue]Dim[/color] wkstBlc [color=darkblue]As[/color] Worksheet, wkstPro [color=darkblue]As[/color] Worksheet
[color=darkblue]Dim[/color] Blanco [color=darkblue]As[/color] [color=darkblue]String[/color], FullProName [color=darkblue]As[/color] [color=darkblue]String[/color]
[color=darkblue]Let[/color] Blanco = "10 172x49ExtRowsGruppiertDumpmeist3in1****SpeedMacros.xlsm"
[color=darkblue]Set[/color] wkstBlc = Workbooks(Blanco).Worksheets.Item(1) [color=green]'First sheet in main File[/color]
[color=darkblue]Let[/color] FullProName = "10 172x49ExtRowsGruppiertErlangen 28.09,2014.xlsm"
[color=darkblue]Set[/color] wkstPro = Workbooks(FullProName).Worksheets.Item(1) [color=green]'First sheet in File with entries[/color]
 [color=darkblue]Dim[/color] lLastRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
 [color=darkblue]Let[/color] lLastRow = 8776
 [color=darkblue]Dim[/color] vLookupValues() [color=darkblue]As[/color] [color=darkblue]Variant[/color] [color=green]'Effectively Column C in Blanco as 1 dimensioinal Array. Not sure why must be variant?? we know size from[/color]
 [color=darkblue]ReDim[/color] vLookupValues(lLastRow - 2) [color=green]' Must use ReDim as Dim only takes numbers, not variables[/color]
 
 [color=darkblue]With[/color] wkstPro
   vLookupTable = .Range("A2:U8776") [color=green]'A*s* over Tit Array[/color]
 [color=darkblue]End[/color] [color=darkblue]With[/color]
 
 [color=darkblue]For[/color] i = [color=darkblue]LBound[/color](vLookupTable) [color=darkblue]To[/color] [color=darkblue]UBound[/color](vLookupTable) [color=green]'First Row to last Row in Pro[/color]
   sKey = vLookupTable(i, 1) [color=green]'Give a unique key to each product in Pro first row[/color]
   [color=darkblue]If[/color] [color=darkblue]Not[/color] dicLookupTable.Exists(sKey) [color=darkblue]Then[/color] [color=green]' check that part number is free??[/color]
      dicLookupTable(sKey) = vLookupTable(i, 3) [color=green]'Assigns the value in column C to that part Number (Key)[/color]
   [color=darkblue]Else[/color]
   [color=darkblue]End[/color] [color=darkblue]If[/color]
 [color=darkblue]Next[/color] i
 
 [color=darkblue]With[/color] wkstBlc
   [color=green]'lLastRow = .Cells(Rows.Count, "A").End(xlUp).Row' Probbably better to do this here And not dimension Array above explicitly in size to be sure of getting (Automtically) dimensioning right[/color]
   vLookupValues = .Range("A2:A" & lLastRow).Value
 [color=darkblue]End[/color] [color=darkblue]With[/color]
  
 [color=darkblue]For[/color] i = [color=darkblue]LBound[/color](vLookupValues) [color=darkblue]To[/color] [color=darkblue]UBound[/color](vLookupValues)
   sKey = vLookupValues(i, 1) [color=green]'give tempory string part number (Product name) in first column of Blanco[/color]
 
 
   [color=darkblue]If[/color] dicLookupTable.Exists(sKey) [color=darkblue]Then[/color] [color=green]'The importent bit. look for that part number in the dictionary[/color]
      vLookupValues(i, 1) = dicLookupTable(sKey) [color=green]'If it is there vLookupValues array the value corresponding to that key[/color]
   [color=darkblue]Else[/color]
      vLookupValues(i, 1) = "" [color=green]' or as JS wrote =CVErr(xlErrNA)'gives the error 'NV[/color]
   [color=darkblue]End[/color] [color=darkblue]If[/color]
 [color=darkblue]Next[/color] i
 [color=darkblue]With[/color] wkstBlc
   .Range("C2").Resize(UBound(vLookupValues) - _
      [color=darkblue]LBound[/color](vLookupValues) + 1, 1) = vLookupValues [color=green]'Use column B2 for the final Array[/color]
 [color=darkblue]End[/color] [color=darkblue]With[/color]
[color=green]'And then finally good practice to close / shut off these sort of things! At least I think I read that somewhere[/color]
TheEnd:
Application.ScreenUpdating = [color=darkblue]True[/color]
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = [color=darkblue]False[/color]
[color=darkblue]Set[/color] dicLookupTable = [color=darkblue]Nothing[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color] [color=green]'Test5_JerryScriptedRuntimeDictionary()[/color]

 

[snb_]

So simple

Sub M_snb()
    ActiveSheet.Cells(1).CurrentRegion.Resize(, 2).Copy
  
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
       .GetFromClipboard
       sn = Split(.GetText, vbCrLf)
    End With
    
    With CreateObject("scripting.filesystemobject")
      Do Until UBound(sn) = -1
      
        c00 = Split(sn(0), vbTab)(1)
        .createtextfile("G:\OF\file" & c00 & ".csv").[COLOR=#ff0000]write Join[/COLOR](Filter(sn, c00), vbCrLf)
        sn = Filter(sn, c00, False)
      Loop
    End With
End Sub

 

[DocAElstein]

So simple

Sub M_snb()
    ActiveSheet.Cells(1).CurrentRegion.Resize(, 2).Copy
  
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
       .GetFromClipboard
       sn = Split(.GetText, vbCrLf)
    End With
    
    With CreateObject("scripting.filesystemobject")
      Do Until UBound(sn) = -1
      
        c00 = Split(sn(0), vbTab)(1)
        .createtextfile("G:\OF\file" & c00 & ".csv").[COLOR=#ff0000]write Join[/COLOR](Filter(sn, c00), vbCrLf)
        sn = Filter(sn, c00, False)
      Loop
    End With
End Sub

. Thanks very much for the reply. Sorry I missed that bit with the = .
- I have books open on my desk with the syntax for .Write and none of them have the = , so I should have seen that.
. The code sort of works now, with a couple of problems:
. 1 It crashes with runtime error ‘9’: Index out of valid ranges at

c00 = Split(sn(0), vbTab)(1)

when c00 tries to go above "84.99"

. 2 The produced files do not look quite right.

For example the 2.99 file looks like this when I copy here from a produced text .txt file
130144328 2.99
130296575 2.99
130441162 12.99
130471767 12.99
130508831 12.99
130472971 12.99
130508865 12.99
130476584 12.99
130476541 12.99
130507707 12.99
130473295 12.99
130473615 12.99
130476470 12.99
130508232 12.99
130511520 12.99
130477860 12.99
130476980 12.99
130473666 12.99
130145814 12.99
130155060 12.99
130155060 12.99
130318261 12.99
130151641 12.99
130147713 12.99
130316142 12.99
130414412 12.99
130415714 12.99
130438836 12.99
130146868 12.99
130150197 12.99
130150197 12.99
130318869 12.99
130318560 12.99
130318885 12.99

When I do the same copying from a produced Excel .csv file the first few lines from that file look like this

130144328 2.99
130296575 2.99
130441162 12.99
130471767 12.99
130508831 12.99
130472971 12.99
130508865 12.99
130476584 12.99
130476541 12.99
130507707 12.99
130473295 12.99
130473615 12.99

<tbody>
</tbody>

… But I note that in the excel file there is no space between the two values and one sees for example in the first cell
1301443282.99
All values in the excel .csv file come out in the first column

And one sees something similar to that in the produced Text .txt file, that is to say no space between the two numbers in the rows.

. I guess this could be an indication of a strange tab / split separator convention as you mentioned.

. The program impresses me with its simplicity compared with mine and is much quicker. So I would be keen to pursue it further if you have the time to make any more suggestions as to wot is going wrong, or other variations for me to try.

Many thanks again
Alan

P.s. Array sn appears in the watch window to produce all of the required info (but still in the format I indicated in Post #22)

 

[snb_]

Please do not quote.

Sub M_snb()
     ActiveSheet.Cells(1).CurrentRegion.Resize(, 2).Copy

    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .GetFromClipboard
        sn = Split(.GetText, vbCrLf)
     End With

    With CreateObject("scripting.filesystemobject")
       Do Until UBound(sn) = -1
          c00 = Split(sn(0), [COLOR=#ff0000]vbTab[/COLOR])(1)
         .createtextfile("G:\OF\file" & c00 & ".csv").write Join(Filter(sn, c00), vbCrLf)
         sn = Filter(sn,[COLOR=#ff0000] vbtab[/COLOR] & c00, False)
       Loop
     End With
 End Sub

I assume you do not use merged cells.

 

[DocAElstein]

Thanks again for the reply.
. The new code is better. It does not crash after producing 84.99 file and indeed produces all files. (In fact it does crash after file “179.99” (error ‘9’: Index out of valid ranges) as it tries to go on to produce another file, but a minor mod

Do Until UBound(sn) [COLOR=#ff0000]- 1 [/COLOR]= -1

Overcomes that one)

. The data however still comes out as indicated in Post #23
. for example the first few lines of file “2.99”, Copied here from a produced .txt file

130144328 2.99
130296575 2.99
130441162 12.99
130471767 12.99
130508831 12.99
…etc.
…………..


And Copied here form a produced excel .csv file

130144328 2.99

130296575 2.99

130441162 12.99

130471767 12.99 …etc

<tbody>
</tbody>

………………..

Both Files on inspection however look as before “to the naked eye” like this
1301443282.99
1302965752.99
13044116212.99
13047176712.99
13050883112.99
….etc

(in the Excel .csv file all numbers are as before in the first column)

. As regards using merged cells: Sorry if this sounds very stupid but I am new to VBA (and computers) and I do not quite understand what you mean by that. I have never changed any internal settings to do with “merging cells”. Sorry for my ignorance there on understanding wot you mean.

Alan

P.s. In case it helps to see any obvious changed or wrong settings that I have, here is the returned file, saved in XL2007 .xlsm as FileName “__split_snb_003”
https://app.box.com/s/mi6xk83duguybrxdzvmw

 

[DocAElstein]

This further modified code:

Sub M_snb4Alan()
     ActiveSheet.Cells(1).CurrentRegion.Resize(, 2).Copy
 
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .GetFromClipboard
        sn = Split(.Gettext, vbCrLf)
     End With
 
    With CreateObject("scripting.filesystemobject")
       Do Until UBound(sn) - 1 = -1
          c00 = Split(sn(0), vbTab)(1)
         .createtextfile("C:\Users\Elston\Desktop\cgreene87TextFiles\PP Output" & c00 & ".txt").write Join(Filter(sn, [COLOR=#ff0000]vbTab &[/COLOR] c00), vbCrLf)
         sn = Filter(sn, vbTab & c00, False)
       Loop
     End With
 End Sub

.. is getting closer still
The output is almost as required by the OP. For example the first two text .txt files give by copying here:
For 2.99;
130144328 2.99
130296575 2.99

For 3.99;
130144361 3.99
130280901 3.99
130280928 3.99
130297455 3.99
130297703 3.99

But again “to the naked eye” in the text file we see

For 2.99;
1301443282.99
1302965752.99

For 3.99;
1301443613.99
1302809013.99
1302809283.99
1302974553.99
1302977033.99

 

[snb_]

Sub M_snb()
      ActiveSheet.Cells(1).CurrentRegion.Resize(, 2).Copy

      With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
         .GetFromClipboard
         sn = filter(Split(.GetText, vbCrLf),[COLOR=#ff0000]vbtab[/COLOR])
      End With

      With CreateObject("scripting.filesystemobject")
        Do Until UBound(sn) = -1
           c00 = Split(sn(0), [COLOR=#ff0000]vbTab[/COLOR])(1)
          .createtextfile("G:\OF\file" & c00 & ".csv").write Join(Filter(sn, [COLOR=#ff0000]vbtab[/COLOR] & c00), vbCrLf)
          sn = Filter(sn, [COLOR=#ff0000]vbtab[/COLOR] & c00, False)
        Loop
      End With
End Sub

FYI: the code didn't crash in the file you uploaded nor in the file I uploaded.

 

[DocAElstein]

. Hi snb.
. Thanks for your continued support on this one.
. I tried your last code out and as you say it does not crash. It is still giving by me the results as I indicated before, that is to say for example in the 2.99 File the following
1301443282.99
1302965752.99
. So By me the problem remains that the price 2.99 is still therer tagged on to the end of the data the OP wanted.


…..
.. This has been a very helpful learning process for me. To that end I took the liberty of “ruining” your code – pulling it apart, opening it up and putting green comment graffiti over it until I (almost all) of it understood. I was then able to do a bodge (shown in orange in my code example below) whiuchat this end cured the problem and so gave the correct results. I think I maybe lack the experiens to “rebuild this working code int your “sane” well structured code. But maybe I will try sometime.. In the meantime if you or anyone else could run the two codes in their Excel and report back the results I think that would be a very valuable contribution to wot is becoming a very good Thread. It would be interesting to see if the problem with your code that I have is a result of some “German” settings I have.
. To that end I include a file with your latest code and my “messy” pulled apart version!
(The user will need to change the output path to a suit. I have it still set a folder on to my desktop)
(Macros in sheet1 Module)
(XL 2007 FileName: __split_snb_004.xlsm )
https://app.box.com/s/fd5vyegpkn83bn3z922t


Many thanks again,
Alan Elston
Bavaria

Messy Code:

[color=green]'Option Explicit 'A good idea here to force me into checking wot everything is[/color]
 
  [color=darkblue]Sub[/color] M_snb3AlanMod()
    ActiveSheet.Cells(1).CurrentRegion.Resize(, 2).Copy [color=green]'Copy all data (and headings) to clip board[/color]
 
    [color=darkblue]Dim[/color] objClipboard [color=darkblue]As[/color] [color=darkblue]Object[/color] [color=green]'Clipboard Object: It has a Funny long name as it is ..not necerssarily anything to do with Excel or FileScripting[/color]
    [color=darkblue]Set[/color] objClipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") [color=green]'..not necerssarily anything to do with Excel or FileScripting[/color]
    objClipboard.GetFromClipboard [color=green]' a necerssary inbetween step. Not quite sure wot it does, maybe sort of preparing the clipboard to give stuff[/color]
 
   
    [color=darkblue]Dim[/color] TextFromClipboard [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Let[/color] TextFromClipboard = objClipboard.GetText [color=green]'This is a bit subtle: It is actually a long string , a TextString comprising values and a carriage return between them[/color]
       
    [color=darkblue]Dim[/color] fsoTextFile [color=darkblue]As[/color] TextStream [color=green]'A sort of file path or Highway for data I think[/color]
   
    [color=darkblue]Dim[/color] sn() [color=darkblue]As[/color] [color=darkblue]String[/color] [color=green]'Array. We do not know the size: It will be set by the Split Function[/color]
   
    [color=darkblue]Dim[/color] FirstLine() [color=darkblue]As[/color] [color=darkblue]String[/color] [color=green]'First Line picked out each time after filtering out last individual price lists[/color]
   
    [color=darkblue]Dim[/color] ItemsAndPrices() [color=darkblue]As[/color] [color=darkblue]String[/color] [color=green]'Array for individual Item And Price lists for similar prices[/color]
    [color=darkblue]Dim[/color] IAndPTabPos [color=darkblue]As[/color] [color=darkblue]Long[/color] [color=green]'Position of tasb in any Item andd Price list line[/color]
    [color=darkblue]Dim[/color] JoinIAndP [color=darkblue]As[/color] [color=darkblue]String[/color] [color=green]'The text string to sent out as a Text Stream[/color]
   
    [color=darkblue]Let[/color] sn = Split(TextFromClipboard, vbCrLf)
   
    [color=darkblue]Dim[/color] fsoFileSystem [color=darkblue]As[/color] FileSystemObject [color=green]'Useful objrctd to do data and data handeling[/color]
    [color=darkblue]Set[/color] fsoFileSystem = CreateObject("scripting.filesystemobject") [color=green]'This one is to do with writing but note in writing you often make something like a file[/color]
   
    [color=darkblue]Dim[/color] j [color=darkblue]As[/color] [color=darkblue]Long[/color], y [color=darkblue]As[/color] Long [color=green]'Numbers for loop count[/color]
    [color=darkblue]Dim[/color] c00 [color=darkblue]As[/color] [color=darkblue]String[/color] [color=green]'An Individual price to use in filtering and in this case identifying a file name.[/color]
   
    [color=darkblue]For[/color] j = 0 [color=darkblue]To[/color] [color=darkblue]UBound[/color](sn) [color=green]' Use UBound to start with to be on the safe side - that would be maximium if no filtering. The j will give the number of files but otherwise is not much use so a Do while sn(0) <>"" Loop is probabbly better similar to wot snb did: better programming practice.[/color]
      [color=darkblue]If[/color] sn(0) = "" [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]For[/color] [color=green]'sn will reduce in size due to the filtering and evtl nothing will be left. Would not be necerssary using the Do While Loop[/color]
      FirstLine = Split(sn(0), vbTab) [color=green]'Split First line   to a 1,2 Array[/color]
      c00 = FirstLine(1) [color=green]'The price given in second column (1) of Array, 8First column is (0)[/color]
      [color=darkblue]Set[/color] fsoTextFile = fsoFileSystem.createtextfile("C:\Users\Elston\Desktop\cgreene87TextFiles\PP Output" & c00 & ".txt") [color=green]'Some how by seting this the text file is created[/color]
      [color=darkblue]Let[/color] ItemsAndPrices = Filter(sn, vbTab & c00) [color=green]'1 Column Array of individual items and prices  with similar prices[/color]
       
        [color=orange][color=darkblue]For[/color] y = 0 [color=darkblue]To[/color] [color=darkblue]UBound[/color](ItemsAndPrices) [color=green]'A Go through bodge to chop off price.[/color]
          [color=darkblue]Let[/color] IAndPTabPos = InStr(ItemsAndPrices(y), vbTab)
          [color=darkblue]Let[/color] ItemsAndPrices(y) = Left(ItemsAndPrices(y), IAndPTabPos - 1) [color=green]'just take first digits before vbTab seperator[/color]
        [color=darkblue]Next[/color] y[/color]
       
      [color=darkblue]Let[/color] JoinIAndP = Join(ItemsAndPrices, vbCrLf) [color=green]' This is a bit subtle: It is actually a long string, a TextString comprising values and a carriage return between them[/color]
      fsoTextFile.write JoinIAndP
      sn = Filter(sn, vbTab & c00, [color=darkblue]False[/color]) [color=green]'We filter out effectivelly up to the next price so that the first valie in second column is the next price to consider[/color]
    [color=darkblue]Next[/color] j
   
     [color=green]'End With[/color]
 End [color=darkblue]Sub[/color]

 

[snb_]

If I open a resulting csv file in notepad there's a tab between the item number and the price.
Since I do not like 'naked eyes' I use Notepad instead.

In VBA you can assign any value to a variable using x="yyyy"; 'Let' is 100% redundant.

You might benefit from:

http://www.snb-vba.eu/VBA_Arrays_en.html#L_6.15.2.3