Solved

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

Posted on 2014-11-14
4
149 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 500 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

Revamp Your Training Process

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action.

Question has a verified solution.

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

Microsoft Office Picture Manager was included in Office 2003, 2007, and 2010, but not in Office 2013. Users had hopes that it would be in Office 2016/Office 365, but it is not. Fortunately, the same zero-cost technique that works to install it with …
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

707 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