asked on

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

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

ASKER CERTIFIED SOLUTION

krishnakrkc

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Harsh Kumar

ASKER

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

Harsh Kumar

ASKER

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

Harsh Kumar

ASKER

Thank alot for the awesome help!