PDA

View Full Version : Solved: Formatting cell contents



Marcster
10-06-2005, 02:10 AM
Hi people,

How do I loop all cells with contents in so the cell then reads:

"CellContent"

I want " enclosing the cell contents to be displayed.
I think the cells must be formatted as text first.

Is there a VBA procedure to do this please?.

So far I have:

Sub FormatWithQuotationMarks()
Dim LastRow As Long
Dim oCell As Range
LastRow = Range("A65536").End(xlUp).Row
Columns("A:H").Select
Selection.NumberFormat = "@"
Range("A1").Select

For Each oCell In Range("A1:G" & LastRow)
oCell.FormulaR1C1 = """ & oCell.Value & """
Next oCell
End Sub

Some of these cell contents will have a zero in front.
Thanks,
Marcster.

Marcster
10-06-2005, 02:31 AM
Tried changing to:


For Each oCell In Range("A1:G" & LastRow)
oCell.Replace What:=oCell.Value, Replacement:=""" & oCell.Value & """, SearchOrder:=xlByColumns, MatchCase:=True
Next oCell

But the cells display:
" & oCell.Value & "

Instead of "CellContents"

mvidas
10-06-2005, 05:47 AM
Hi Marcster,

First thing, when in vba and dealing with strings, to produce a " symbol you need to have two "" symbols to show it. So if 'quot' was a string variable, then usingquot="""" would make it equal to a single " symbol. quot="""""" would make it two, and so on.

There are two ways you could do this, the second is much faster, as it uses an array transfer, but again if it has any formatting it could be lost without knowing about it ahead of time. The first keeps the cell format as it is, so if you had a cell with "=TODAY()", then the first would then show "10/06/05" (depending on regional settings, and the second would show "38631".

In any case, here are the two routines:Sub MarcsterFixQuotes1()
Dim FND As Range, FND1 As Range
Set FND = Cells.Find("*", LookIn:=xlValues)
If FND Is Nothing Then Exit Sub 'blank sheet
Set FND1 = FND
Application.ScreenUpdating = True
FND = """" & FND.Text & """"
Set FND = Cells.FindNext(FND)
Do Until FND.Address = FND1.Address
FND = """" & FND.Text & """"
Set FND = Cells.FindNext(FND)
Loop
Application.ScreenUpdating = False
End Sub
Sub MarcsterFixQuotes2()
Dim UsedRG As Range, UsedArr(), R As Long, C As Long
Set UsedRG = ActiveSheet.UsedRange
UsedArr = UsedRG.Value
For R = 1 To UBound(UsedArr, 1)
For C = 1 To UBound(UsedArr, 2)
If UsedArr(R, C) <> "" Then UsedArr(R, C) = """" & UsedArr(R, C) & """"
Next 'C
Next 'R
UsedRG.Value = UsedArr
End SubLet me know if you have any questions!
Matt

Marcster
10-06-2005, 06:14 AM
Cheers Matt :beerchug: works great.
Thanks for pointing out where I was going wrong too, thanks again :bow: .

I have another question though:

In another worksheet I have data shown as:
123456 text1 12345678 100.00 text2 99
654321 text2 87654321 99.10 text2 99
741852 text3 96385246 1.22 text3 99

Is there a procedure to write this to a text file so when opened
in notepad it should look like:
"123456","text1","12345678","100.00","text2","99"
"654321","text2","87654321","99.10","text2","99"
"741852","text3","96385246","1.22","text3","99"
Thanks,

Marcster.

mvidas
10-06-2005, 06:33 AM
Easily, though I don't believe there is anything built in to do it. But if you wanted to use the 'exportrange' function from my post to you yesterday (http://www.vbaexpress.com/forum/showpost.php?p=46350&postcount=10), just change the for i/j loops in the center to: For i = 1 To UBound(URArr, 1)
For j = 1 To UBound(URArr, 2) - 1
'ExpArr(i) = ExpArr(i) & URArr(i, j) & vDelimiter
ExpArr(i) = ExpArr(i) & """" & URArr(i, j) & """" & vDelimiter
Next 'j
'ExpArr(i) = ExpArr(i) & URArr(i, UBound(URArr, 2))
ExpArr(i) = ExpArr(i) & """" & URArr(i, UBound(URArr, 2)) & """"
Next 'iI commented out the two lines I changed, and you should just be able to use that! You could send it a .UsedRange of a worksheet, or a specific range if you wanted as well.
Matt

mvidas
10-06-2005, 06:34 AM
oops scrap that, you have some custom formatting on that. Give me a sec, I'll get you a better one

mvidas
10-06-2005, 06:40 AM
OK, this should do as you'd likeFunction ExportRangeAsDisplayed(ByVal TheRange As Range, ByVal TheFile As String, _
Optional ByVal vDelimiter As String = ",") As Boolean
Dim RW As Range, CLL As Range, tempStr As String, vFF As Long
If TheRange.Areas.Count > 1 Then Exit Function 'should only be one area
vFF = FreeFile
Open TheFile For Output As #vFF
For Each RW In TheRange.Rows
tempStr = ""
For Each CLL In RW.Cells
tempStr = tempStr & """" & CLL.Text & """" & vDelimiter
Next 'CLL
tempStr = Left$(tempStr, Len(tempStr) - Len(vDelimiter))
Print #vFF, tempStr
Next 'RW
Close #vFF
ExportRange = True
Exit Function
QuitFunc:
End FunctionMatt

Marcster
10-06-2005, 07:50 AM
Thanks Matt :thumb. Works great.
But when run it errors,
ExportRange = True
Should this be ExportRangeAsDisplayed = True?.
At the moment i've commented out the line.

Once again thank you :friends: ,

Marcster.

mvidas
10-06-2005, 07:55 AM
Yes, it should be ExportRangeAsDisplayed :yes Can you tell I didn't test or compile this? :)
The line isn't necessary, it would only be if you wanted to call it with something likeIf ExportRangeAsDisplayed(arg1, arg2, arg3) = False then Msgbox "Export Failed"Otherwise I only have it as a boolean function to save memory. But I figured since I did that, I might as well let you test the boolean value :)

Marcster
10-06-2005, 07:59 AM
Thought it might of been.
I can use the return value to see if it ran ok like you suggested.

Thanks for all your help,

Marcster.

mvidas
10-06-2005, 08:18 AM
Glad to help, let me know if you need anything else!