Solved

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

Posted on 2014-11-14
4
125 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
  • 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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Recently Microsoft released a brand new function called CONCAT. It's supposed to replace its predecessor CONCATENATE. But how does it work? And what's new? In this article, we take a closer look at all of this - we even included an exercise file for…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

744 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

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now