Solved

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

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

Networking for the Cloud Era

Join Microsoft and Riverbed for a discussion and demonstration of enhancements to SteelConnect:
-One-click orchestration and cloud connectivity in Azure environments
-Tight integration of SD-WAN and WAN optimization capabilities
-Scalability and resiliency equal to a data center

Question has a verified solution.

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

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…
Using Word 2013, I was experiencing some incredible lag when typing.  Here's what worked for me....
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

856 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