• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

.xls file with VBA required

ianb

ianb

Member
Hi,


I have an .xls file with columns A to D with title headers.


What I am looking for is a module that I can run once a user has entered the data in each column.


Simply the data will save into a file with a name and the date and time.

The file will be .csv or .txt and around each of the cells will be " at the start and " at the end plus , for the divider of each fo the cells from excel to .csv or .txt as listed below.


I can then have a button for the user to click once they have entered the data which will save in a named folder location ready for processing.


Does any one have such a program (or soltion)


Many Thanks. Ian.


example fo the output file I require :

[pre]
Code: 
"DomainName","sAMAccountName","AttributeName","OLD_VALUE","NEW_VALUE"
"PRBUK","T01234456","EmployeeID","","0123456Y","S3423478"
"AN","D4823782","EmployeeID","","0123456Y","S3423478
[/pre]
p.. numberous attempt have come close yet not the solution.
 
So, to summarize:

1) Want to be able to save a file from XL,

2) where each cell's contents gets surrounded by quotation marks, and

3) each cell is separate by commas

4) all of the above to be completed via a macro


Did I understand you correctly?
 
Hi Luke,


1. .XLS File (The Data Input File)

2. Yes, "Domain"

3. "Domain","User ID",

4. Click of a button and will save as :


a) Output-11-04-2013-17:30.txt or Output-11-04-2013-17:30.csv


Yes Yes Yes.... please.
 
Hi, ianb!


A couple of doubts:

a) One file per row?

b) At the time user completes Ax:Dx range or once for A1:Dx range?

c) You said 4 columns but in your posted example there are mixed titles with data, could you please elaborate or upload a sample file with the input and the desired output?


Regards!
 
Hi,


1 XLS file with headers and multi rows and columns *(some could be blank)


2 once all rows and columsn have been completed as they are entering data for multi users.


3. the amount of rows is 5 in total (all blank cells need to be blank)

pass attempt puts "" in all the balnk cells which I just need blanks

e.g. I27 cell would just be a blank. B4 would be ""
 
Update


1. 1 File per data entry for multi rows.


only when the vba program is run is the data entry finished.

e.g. I will put a button on the excel spreadsheet.
 
Hi, ianb!


Give a look at this file:

https://dl.dropboxusercontent.com/u/60558749/.xls%20file%20with%20VBA%20required%20%28for%20ianb%20at%20chandoo.org%29.xls


This is the code:

-----

[pre]
Code: 
Option Explicit

Sub SaveYourSoul()
' constants
Const kbFullLines = True
Const ksWSInput = "Hoja1"
Const ksPrefix = "Output_"
Const ksSuffix = ".txt"
Const ksComma = ","
Const ksQuote = """"
Const ksTail = "tail"
' declarations
Dim wsI As Worksheet
Dim fs As Object, fn As Object
Dim sPath As String, sFile As String
Dim I As Long, J As Integer, A As String
Dim bEnd As Boolean, iFill As Integer, bNew As Boolean, iColumns As Integer
' start
Set wsI = ThisWorkbook.Worksheets(ksWSInput)
With wsI
iColumns = wsI.Cells(1, .Columns.Count).End(xlToLeft).Column
End With
' process
'  file name
sPath = ThisWorkbook.Path & Application.PathSeparator
sFile = ksPrefix & Format(Now(), "yyyy.mm.dd_hh.mm.ss") & ksSuffix
'  file system
Set fs = CreateObject("Scripting.FileSystemObject")
Set fn = fs.CreateTextFile(sPath & sFile, True)
'  worksheet
With wsI
bEnd = False
bNew = True
For I = 2 To .Rows.Count
' non empty columns
iFill = iColumns
For J = 1 To iColumns
If .Cells(I, J).Value = "" Then iFill = iFill - 1
Next J
' check if output
If kbFullLines And iFill = iColumns Or _
Not kbFullLines And iFill <> 0 Then
If bNew Then
' titles
bNew = False
A = ""
For J = 1 To iColumns
If J > 1 Then A = A & ksComma
A = A & ksQuote & .Cells(1, J).Value & ksQuote
Next J
A = A & ksComma & ksQuote & ksTail & ksQuote
fn.WriteLine A
End If
' data
A = ""
For J = 1 To iColumns
If J > 1 Then A = A & ksComma
A = A & ksQuote & .Cells(I, J).Value & ksQuote
Next J
A = A & ksComma
fn.WriteLine A
End If
' done?
If iFill = 0 Then Exit For
Next I
End With
'  close & save new file
fn.Close
'  close & don't save workbook
'ThisWorkbook.Close False
' end
Beep
End Sub
[/pre]
-----


As I didn't fully understand your requirement as as you didn't post a sample file with detailed output, it only writes full lines (non empty data in the 4 columns), so if you wish to write all lines even with empty partial data change the value of the constant kFullLines.


Just advise if any issue.


Regards!
 
Many Thanks Sir JB.


Will test this out today.


Enjoyed the Sub name too !!!


Happy to be at work with you...!!
 
PERFECT !!! Just make it look nice n happy. It works with what I require.


Many thanks. Have a working example now to also learn from.


Kind Regards as always.....


Ian.
 
Here's one more option.

[pre]
Code: 
Option Explicit
Sub SaveYourSoul2()
Dim i As Long, LastRow As Long
Dim iFile As Integer
Dim strJoin As String, strAddr As String, strFile As String
Dim varRslt, varPrnt()

With Sheets("Hoja1")

LastRow = .Cells.Find("*", [A1], xlFormulas, xlWhole, xlByRows, xlPrevious, False).Row
ReDim varPrnt(LastRow - 1)

For i = 1 To LastRow
strAddr = .Range(.Cells(i, 1), .Cells(i, 4)).Address 'Change 4 to suit last col
varRslt = Replace(Join(Evaluate("=IF(" & strAddr & "<>""""," & strAddr & ",""~"")"), _
","), "~", "")
strJoin = Chr(34) & Replace(varRslt, ",", Chr(34) & "," & Chr(34)) & Chr(34)
varPrnt(i - 1) = strJoin
Next i

strFile = ThisWorkbook.Path & Application.PathSeparator & "Output-" & Format(Now(), _
"yyyy.mm.dd_hh.mm.ss") & ".txt"

iFile = FreeFile
Open strFile For Output As iFile
Print #iFile, Join(varPrnt, vbCrLf)
Close #iFile

End With

End Sub
[/pre]
 
Hi, ianb!

Glad you solved it. Thanks for your feedback and for your kind words too. And welcome back whenever needed or wanted.

Regards!

PS: BTW shrivallabha solution works fine too.


@shrivallabha

Hi!

The good old FreeFile, Open For As, Print & Close... bring me old memories... of course as if I had learned them yesterday :)

Regards!
 
Hi JB,


What adjustment to your VBA program would I need to do to have :


1) a comma after the last column (title and data)

2) "tail" as an additional checker as a column or text (never has data in this column)


Then this .txt file will we utilized as a business requirement.


See Present and Future for additional visionary progression !!!


Present

"DomainName","sAMAccountName","AttributeName","OLD_VALUE","NEW_VALUE" "PRBUK","D4350830","Company","Produban","UK"


Future

"DomainName","sAMAccountName","AttributeName","OLD_VALUE","NEW_VALUE","tail"

"PRBUK","D4350830","Company","Propeps","UK",

"AN","D4350340","Company","Propeps","USA",
 
Also in testing I noticed that is a cell is empty in .xls with JB program that the whole row does not get saved. whilst shrivallabha program will allow for a field being blank. Would liek the row to be included if a blank cell in the row.


Workig with both programs aas a learning curve. further assistance would be appreciated.

e.g.


"DomainName","sAMAccountName","AttributeName","OLD_VALUE","NEW_VALUE","tail"

"PRBUK","","Company","Propeps","UK",

"AN","D4350340","Company","","USA",
 
If your header row is one [or some fixed row] then you can actually make the code a little more flexible as below:

[pre]
Code: 
Option Explicit
Sub SaveYourSoul2()
Dim i As Long, LastRow As Long, LastCol As Long 'Added a variable here
Dim iFile As Integer
Dim strJoin As String, strAddr As String, strFile As String
Dim varRslt, varPrnt()

With Sheets("Hoja1")

LastRow = .Cells.Find("*", [A1], xlFormulas, xlWhole, xlByRows, xlPrevious, False).Row
LastCol = .Cells(1,Columns.Count).End(xlToLeft).Column 'Find out the last column
ReDim varPrnt(LastRow - 1)

For i = 1 To LastRow
strAddr = .Range(.Cells(i, 1), .Cells(i, LastCol)).Address 'Changed 4 with variable defined i.e. LastCol
varRslt = Replace(Join(Evaluate("=IF(" & strAddr & "<>""""," & strAddr & ",""~"")"), _
","), "~", "")
strJoin = Chr(34) & Replace(varRslt, ",", Chr(34) & "," & Chr(34)) & Chr(34)
varPrnt(i - 1) = strJoin
Next i

strFile = ThisWorkbook.Path & Application.PathSeparator & "Output-" & Format(Now(), _
"yyyy.mm.dd_hh.mm.ss") & ".txt"

iFile = FreeFile
Open strFile For Output As iFile
Print #iFile, Join(varPrnt, vbCrLf)
Close #iFile

End With

End Sub
[/pre]
@SirJB7: I sometimes do this to re-mind me as I don't [have to] do VBA programming in office.
 
Hi, ianb!


a) Tail: updated code and file in previous post, please check it and download again from same previous link.

Lines added: constant ksTail, "a = a & tail" and "a = a & ," at title and detail lines.


b) Empty lines: that was yet handled by the constant kbFullLines as I wrote just below the posted code. Set it to True to write only lines with all fiels, set it to False to write the line even if it has empty fields.


NOTE: keep in mind that process ends when a whole line is empty.


Regards!
 
It looks great. Many thanks your your time once again.


Both prgrams are very usful to myself and I am sure to others working with data input and loading files for automation.
 
Hi JB,


If I wanted to make my program more flexable (Yoga Classes for VBA!!!)


I would have your program plus a new sheet and cell where a person could enter how many columns required. enter the additonal titles and nformation in and then run your program.


The cell entry box would be on a new work sheet. Can you advise how this is done please.


I would think we need to reference cell as being : Const kiColumns = <Sheet2.Cellb16>


The input data location would remain the same also the criteria would be the same.


Const kbFullLines = False

Const ksWSInput = "Input_Data"

Const kiColumns = 10


Regards,
 
Best Idea would be the amount of columns is equal to the amount of title cells (plus of course the tail) Sound like we are chasing mice....!!!


Do you have a solution also what is the best design way.


a) Const kiColumns = <random> based upon titles entered.


or


b) Const kiColumns = <cell number in range>


p.s. did attempt b) yet program did not pick up cell range !


From a design point of view a) Ithink is the best way as user does not need to input the amount of columns. many thanks.
 
Hi Shriva, I did try this program and it works fine for the multi additonal lines.


What I also would require on your version of the program would be "tail" added to the titles (same as JB's final program and also symbol , after the end of each rows.


Can you advise on the adjustments to your program please.


Then I have 1 program operational by JB and 1 Program operational by you.


Regards
 
Hi, ianb!


File updated and re-uploaded and code fixed in original post, so download again from there.

Changes:

-----

[pre]
Code: 
With wsI
iColumns = wsI.Cells(1, .Columns.Count).End(xlToLeft).Column
End With[/pre]
-----

and replacing usage of constant kiColumns by variable iColumns.


As you could see both shrivallabha version and mine works alike, finding last column from the rightmost of the worksheet to the left, which assures you the actual last column even if there are empth columns in the middle as opposite to usual methods of:

-----

.Cells(1, 1).End(xlToRight)

-----

where it stops at first blank entry.


Regards!
 
Just replace the following:

Code: 
strJoin = Chr(34) & Replace(varRslt, ",", Chr(34) & "," & Chr(34)) & Chr(34)

with:

[pre]strJoin = Chr(34) & Replace(varRslt, ",", Chr(34) & "," & Chr(34)) & Chr(34) & _
"," & Chr(34) & "LineEnd" & Chr(34)
[/pre]
so it will show you ,"LineEnd" at the end of each line!
 
You must log in or register to reply here.
Back
Top