?
Solved

Excel, Need help to create a txt from vba through Excel with a combine formula

Posted on 2014-11-14
4
Medium Priority
?
150 Views
Last Modified: 2014-11-14
Hi,

I'm in need of being able to combine a column with email address into one row with with comma in between, i have a code that works perfectly for that but i want to amend it a bit so it would ask which column it should combine and what cell it should start from, and then paste it into a new sheet and save that sheet as a *.txt file into c:/temp, if the temp folder is not there then it should create a temp folder first.

Is that possible?

this is the code i have:

Function Combine(WorkRng As Range, Optional Sign As String = ",") As String

Dim Rng As Range
Dim OutStr As String
For Each Rng In WorkRng
If Rng.Text <> "," Then
OutStr = OutStr & Rng.Text & Sign
End If
Next
Combine = Left(OutStr, Len(OutStr) - 1)
End Function

Open in new window

0
Comment
Question by:Hakum
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
4 Comments
 
LVL 18

Accepted Solution

by:
krishnakrkc earned 2000 total points
ID: 40442325
Try

Option Explicit

Sub kTest()
    
    Dim r   As Range, txt As String, x As String
    Dim k, Delim As String, i As Long
    
    Delim = ","  '<<< adjust the delimiter
    
    Set r = Application.InputBox("Select the range.", "Range to combine", Type:=8)
    
    If Not r Is Nothing Then
        x = "'" & r.Parent.Name & "'!" & r.Address
        k = Evaluate("if(len(" & x & ")," & x & ",""#"")")
        If UBound(k, 2) > 1 Then
            For i = 1 To UBound(k, 2)
                txt = txt & Delim & Join(Filter(Application.Transpose(Application.Index(k, 0, i)), "#", 0), Delim)
            Next
            If Len(txt) Then txt = Mid(txt, Len(Delim) + 1)
            If Right(txt, Len(Delim)) = Delim Then txt = Left(txt, (Len(txt) - Len(Delim)))
        Else
            txt = Join(Filter(Application.Transpose(k), "#", 0), Delim)
        End If
        If Len(txt) Then
            If Not CBool(Len(Dir("C:\Temp\", vbDirectory))) Then
                MkDir "C:\Temp"
            End If
            With CreateObject("Scripting.FileSystemObject")
                Set k = .OpenTextFile("C:\Temp\textfile.txt", 2, 1)
                k.writeline txt
                k.Close
            End With
        End If
    End If
    
End Sub

Open in new window


Kris
0
 
LVL 1

Author Comment

by:Hakum
ID: 40442332
Thanks alot kris! it works like a charms altough i have one tiny change of the previous request made.. is it possible to when running the code to choose a location where the text file should be saved instead of automatically saving in the c:/temp folder?

so basicly it promts you where to save the text file
0
 
LVL 1

Author Comment

by:Hakum
ID: 40442644
I found a alternative solution:

Option Explicit

Sub Flet()
    
    Dim r   As Range, txt As String, x As String
    Dim k, Delim As String, i As Long
    
    Delim = ","  '<<< adjust the delimiter
    
    Set r = Application.InputBox("Choose Range", "Choose Range to combine", Type:=8)
    
    If Not r Is Nothing Then
        x = "'" & r.Parent.Name & "'!" & r.Address
        k = Evaluate("if(len(" & x & ")," & x & ",""#"")")
        If UBound(k, 2) > 1 Then
            For i = 1 To UBound(k, 2)
                txt = txt & Delim & Join(Filter(Application.Transpose(Application.Index(k, 0, i)), "#", 0), Delim)
            Next
            If Len(txt) Then txt = Mid(txt, Len(Delim) + 1)
            If Right(txt, Len(Delim)) = Delim Then txt = Left(txt, (Len(txt) - Len(Delim)))
        Else
            txt = Join(Filter(Application.Transpose(k), "#", 0), Delim)
        End If
        If Len(txt) Then
            If Not CBool(Len(Dir("C:\Temp\", vbDirectory))) Then
                MkDir "C:\Temp"
            End If
            With CreateObject("Scripting.FileSystemObject")
                Set k = .OpenTextFile("C:\Temp\mails.txt", 2, 1)
                k.writeline txt
                k.Close
            End With
                
                msg_openfile
                        
        End If
    End If
    
End Sub

Sub msg_openfile()
    Dim oShell As Object
    Dim iResponse As Integer
    Set oShell = CreateObject("Wscript.Shell")
     
    iResponse = MsgBox("Combine completede successfully. Do you want to open file?", _
    vbYesNo, "Fletning Successfuldt")
     
    If iResponse = vbYes Then
        oShell.Run ("c:/temp/mails.txt")
    Else
        Exit Sub
    End If
     
End Sub

Open in new window

0
 
LVL 1

Author Closing Comment

by:Hakum
ID: 40442645
Thank alot for the awesome help!
0

Featured Post

Free Backup Tool for VMware and Hyper-V

Restore full virtual machine or individual guest files from 19 common file systems directly from the backup file. Schedule VM backups with PowerShell scripts. Set desired time, lean back and let the script to notify you via email upon completion.  

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
After seeing numerous questions for Dynamic Data Validation I notice that most have used Visual Basic to solve the problem. This suggestion is purely formula based and can be used in multiple rows.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

764 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question