Formating a list in Excel using VBA

Hi there,

I have a column of contract numbers in Column A that I would like to format as below:

('contract#1','contract#2','contract#3',................,'contract#x')

Where contract#x is the last contract number on the list.

The result could be in a single cell or entered in a seperate txt file... .either way is fine.

Could anyone help out with this code in VBA?

Thanks,
Mattt
AleynaAsked:
Who is Participating?
 
Jeroen RosinkSoftware testing consultantCommented:
it would be then something like:
Sub WriteToTextFile()
Dim FileNum As Integer, i As Long
RowsA = Cells(rows.Count, 1).End(xlUp).Row
tmp = ""
RowsA = Cells(rows.Count, 1).End(xlUp).Row
    If Dir("C:\temp\TEXTFILE.TXT") <> "" Then
        ' deletes the file if it exists
        Kill "C:\temp\TEXTFILE.TXT"
    End If
    FileNum = FreeFile ' next free filenumber
    Open "C:\temp\TEXTFILE.TXT" For Output As #FileNum
    ' creates the new file
    'Open "C:\FOLDERNAME\TEXTFILE.TXT" For Append As #FileNum
    ' appends the input to an existing file
    ' write to the textfile
    For i = 1 To RowsA
        If tmp = "" Then
            tmp = "('" & Cells(i, 1)
        Else
            tmp = tmp & "','" & Cells(i, 1)
        End If
         
    Next i
    tmp = tmp & "')"
      Write #FileNum, tmp
    Close #FileNum ' close the file
End Sub
0
 
Jorge PaulinoIT Pro/DeveloperCommented:
Why don't you goto Data - text to columns and split by ',' ? If you need some automation you can record a macro.
0
 
Jeroen RosinkSoftware testing consultantCommented:
Hello Mattt,
To get the values in one single cell like cell B1 then this macro might help you out.

Sub ColumnInCellB1()
Dim rows As Long
Dim tmp As String
RowsA = Cells(rows.Count, 1).End(xlUp).Row
tmp = ""
For i = 1 To RowsA
If tmp = "" Then
    tmp = Cells(i, 1)
Else
    tmp = tmp & vbLf & Cells(i, 1)
End If
'place content of column A in cell B1
[B1] = tmp
End Sub

regards,
Jeroen
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
Jeroen RosinkSoftware testing consultantCommented:
to write the content of column A to a text file loacted on: C:\temp\TEXTFILE.TXT

Sub WriteToTextFile()
Dim FileNum As Integer, i As Long
RowsA = Cells(rows.Count, 1).End(xlUp).Row
tmp = ""
RowsA = Cells(rows.Count, 1).End(xlUp).Row
    If Dir("C:\temp\TEXTFILE.TXT") <> "" Then
        ' deletes the file if it exists
        Kill "C:\temp\TEXTFILE.TXT"
    End If
    FileNum = FreeFile ' next free filenumber
    Open "C:\temp\TEXTFILE.TXT" For Output As #FileNum
    ' creates the new file
    'Open "C:\FOLDERNAME\TEXTFILE.TXT" For Append As #FileNum
    ' appends the input to an existing file
    ' write to the textfile
    For i = 1 To RowsA
        Write #FileNum, Cells(i, 1)
    Next i
    Close #FileNum ' close the file
End Sub
0
 
AleynaAuthor Commented:
Sorry maybe I wasn't too clear, at the moment I have this in column A (the real list is longer)

12345
45678
34567

And I need to get this list to be:

('12345','45678','34567')

So thats why I think I need a macro to complete the task.

Thanks for your quick responces.
Regards,
Matt
0
 
AleynaAuthor Commented:
Roos01,

The last code is close... but it creates a txt file like this

"123"
"345"
"456"

instead can you do it so that it does:

('123','345','456')
0
 
Jeroen RosinkSoftware testing consultantCommented:
replace the lines of code:

    For i = 1 To RowsA
        Write #FileNum, Cells(i, 1)
    Next i

with

    For i = 1 To RowsA
If tmp = "" Then
    tmp = Cells(i, 1)
Else
    tmp = tmp & ", "& Cells(i, 1)
End If
    Next i

        Write #FileNum, tmp

Do you also need the single quotes and the ( and) around?

0
 
AleynaAuthor Commented:
Roos01,

we are really close... at the moment I get this:

"123, 123, 45, 125"

I need it as:

('123','123','45','125')

So basicaly the " has to change to a ' and also it has to be at the begining and end of each number
and yes the ( and ) are also need
0
 
AleynaAuthor Commented:
Roos01,

the last code gives me:

"('123','123','45','125')"

Which is great, know if I may be picky is it possible to remove the beginign and ending "  the reason is I won't be the only one using this code so I don't want other users to copy the " by mistake,,

You are a legend, thanks for your help!

Regards,
M
0
 
Jeroen RosinkSoftware testing consultantCommented:
I tried to get the first and last quotes away, still as it is an string, VBA deals with it as a string. Sorry I cannot get closer to this. An option would be creating another file where it removes all quotes. The it is to hope that none places in a cell an "

Jeroen
0
 
AleynaAuthor Commented:
Jeroen,

I will just let the team know... Thanks so much for yuor help!!

This will really help a lot!
Regards,
Matt
0
 
Jeroen RosinkSoftware testing consultantCommented:
Hello Matt,

here some piece of nasty code added to remove the all quotes

Sub WriteToTextFile()
Dim FileNum As Integer, i As Long
RowsA = Cells(Rows.Count, 1).End(xlUp).Row
tmp = ""
RowsA = Cells(Rows.Count, 1).End(xlUp).Row
    If Dir("C:\temp\TEXTFILE.TXT") <> "" Then
        ' deletes the file if it exists
        Kill "C:\temp\TEXTFILE.TXT"
    End If
    FileNum = FreeFile ' next free filenumber
    Open "C:\temp\TEXTFILE.TXT" For Output As #FileNum
    ' creates the new file
    'Open "C:\FOLDERNAME\TEXTFILE.TXT" For Append As #FileNum
    ' appends the input to an existing file
    ' write to the textfile
    For i = 1 To RowsA
        If tmp = "" Then
            tmp = "('" & Cells(i, 1)
        Else
            tmp = tmp & "','" & Cells(i, 1)
        End If
         
    Next i
    tmp = tmp & "')"
      Write #FileNum, tmp
    Close #FileNum ' close the file
   
    ReplaceTextInFile "C:\temp\TEXTFILE.TXT", Chr(34), ""
   
End Sub
Sub ReplaceTextInFile(SourceFile As String, _
    sText As String, rText As String)
Dim TargetFile As String, tLine As String, tString As String
Dim p As Integer, i As Long, F1 As Integer, F2 As Integer
    TargetFile = "RESULT.TMP"
    If Dir(SourceFile) = "" Then Exit Sub
    If Dir(TargetFile) <> "" Then
        On Error Resume Next
        Kill TargetFile
        On Error GoTo 0
        If Dir(TargetFile) <> "" Then
            MsgBox TargetFile & _
                " already open, close and delete / rename the file and try again.", _
                vbCritical
            Exit Sub
        End If
    End If
    F1 = FreeFile
    Open SourceFile For Input As F1
    F2 = FreeFile
    Open TargetFile For Output As F2
    i = 1 ' line counter
    Application.StatusBar = "Reading data from " & _
        TargetFile & " ..."
    While Not EOF(F1)
        If i Mod 100 = 0 Then Application.StatusBar = _
            "Reading line #" & i & " in " & _
            TargetFile & " ..."
        Line Input #F1, tLine
        If sText <> "" Then
            ReplaceTextInString tLine, sText, rText
        End If
        Print #F2, tLine
        i = i + 1
    Wend
    Application.StatusBar = "Closing files ..."
    Close F1
    Close F2
    Kill SourceFile ' delete original file
    Name TargetFile As SourceFile ' rename temporary file
    Application.StatusBar = False
End Sub

Private Sub ReplaceTextInString(SourceString As String, _
    SearchString As String, ReplaceString As String)
Dim p As Integer, NewString As String
    Do
        p = InStr(p + 1, UCase(SourceString), UCase(SearchString))
        If p > 0 Then ' replace SearchString with ReplaceString
            NewString = ""
            If p > 1 Then NewString = Mid(SourceString, 1, p - 1)
            NewString = NewString + ReplaceString
            NewString = NewString + Mid(SourceString, _
                p + Len(SearchString), Len(SourceString))
            p = p + Len(ReplaceString) - 1
            SourceString = NewString
        End If
        If p >= Len(NewString) Then p = 0
    Loop Until p = 0
End Sub

Jeroen
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.