A Faster way to Change value to string using the quote mark

[stakar]

I have the following code

code:
-------------------------------------------------------------------------------


Set rng = Range([BH4], [A65536].End(xlUp)(1, 60))
Set checkboxrange = [A1:BG1].SpecialCells(xlCellTypeConstants, 2)

For Each ThisCell In checkboxrange
s = s & "&" & ThisCell(4).Address(False, False)
Next ThisCell

'Turn off screen
Application.ScreenUpdating = False

rng.ClearContents
[BH4] = "=" & Mid(s, 2, Len(s) - 1)
[BH4].Copy rng
rng.Copy
rng.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

-------------------------------------------------------------------------------


The above code concatenate checked cells and copy them till the end o
the range "BH" and then using the copy paste special, copies only th
values.
What I want is , for each value to add the quote (eg '01 or '0 o
'00010 etc) because i want to change them to strings

2 specialist gave me the following codes from a different view, bu
both do exactly what i want
The problem is that they are both EXTREMELY slow because i have mor
than 1000 rows to change

code #1:
-------------------------------------------------------------------------------


Dim x As Long
Dim y As Long

y = Range("B65536").End(xlUp).Row
For x = 1 To y
Range("B" & x).Value = "'" & Range("B" & x).Value
Next x
-------------------------------------------------------------------------------


code #2:

Change
------------------------------------------
rng.Copy
rng.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

 

[Bob Phillips]

If you just want to change them to strings, rather than loop through each
cell and add a quote, could you not just change the format to text instead
to text, like

Range("B1:B" & Cells(Rows.Count,"A").End(xlUp).Row).NumberFormat = "@"

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[stakar]

*If you just want to change them to strings, rather than loop throug
each
cell and add a quote, could you not just change the format to tex
instead
to text, like

Range("B1:B" & Cells(Rows.Count,"A").End(xlUp).Row).NumberFormat
"@"

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

I have the following code

code:
--------------------------------------------------------------------------
------


Set rng = Range([BH4], [A65536].End(xlUp)(1, 60))
Set checkboxrange = [A1:BG1].SpecialCells(xlCellTypeConstants, 2)

For Each ThisCell In checkboxrange
s = s & "&" & ThisCell(4).Address(False, False)
Next ThisCell

'Turn off screen
Application.ScreenUpdating = False

rng.ClearContents
[BH4] = "=" & Mid(s, 2, Len(s) - 1)
[BH4].Copy rng
rng.Copy
rng.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

--------------------------------------------------------------------------
------


The above code concatenate checked cells and copy them till the en of
the range "BH" and then using the copy paste special, copies onl the
values.
What I want is , for each value to add the quote (eg '01 or '0 or
'00010 etc) because i want to change them to strings

2 specialist gave me the following codes from a different view but
both do exactly what i want
The problem is that they are both EXTREMELY slow because i hav more
than 1000 rows to change

code #1:
--------------------------------------------------------------------------
------


Dim x As Long
Dim y As Long

y = Range("B65536").End(xlUp).Row
For x = 1 To y
Range("B" & x).Value = "'" & Range("B" & x).Value
Next x
--------------------------------------------------------------------------
------


code #2:

Change
------------------------------------------
rng.Copy
rng.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
---------------------------------------
to
---------------------------------------
Dim myCell As Range
For Each myCell In rng
myCell.Value = "'" & myCell.Value
Next myCell

Its not working that way!! the isnumber() returns true when the valu
is below 10. I need to add the quote. that the ONLY way because i l
have test all other possible ways

 

[XL-Dennis]

Altenrative You may consider to use an array of the datatype variant
like the following:


Code:
--------------------

Option Explicit

Sub Perhaps_Faster()
Dim rnData As Range
Dim vaData As Variant
Dim i As Long

Set rnData = Range(Range("B2"), Range("B65536").End(xlUp))

vaData = rnData.Value

For i = 1 To UBound(vaData)
vaData(i, 1) = Left(vaData(i, 1), 4)
Next i

rnData.Value = vaData

End Sub

 

[stakar]

Altenrative You may consider to use an array of the datatyp
variant like the following:
Code
-------------------

Option Explicit

Sub Perhaps_Faster()
Dim rnData As Range
Dim vaData As Variant
Dim i As Long

Set rnData = Range(Range("B2"), Range("B65536").End(xlUp))

vaData = rnData.Value

For i = 1 To UBound(vaData)
vaData(i, 1) = Left(vaData(i, 1), 4)
Next i

rnData.Value = vaData

End Sub
-------------------


Kind regards,
Dennis

Thanks you all for your replay
i just found the way to do it!!

code:
---------------------------------------------------------------------------------
Dim SourceArr() As Variant, r As Long, TempVal

'Place data source into an array
SourceArr = Range("BH1:BH" & Range("A65536").End(xlUp).Row)

'Take number off string, add 100 then put back the value as a ne
string

For r = 1 To UBound(SourceArr, 1)
TempVal = SourceArr(r, 1)
SourceArr(r, 1) = "'" & Mid(TempVal, 1)
Next r

'Place array into column BH
Range(Cells(1, 60), Cells(UBound(SourceArr, 1), 60)) = SourceArr

 

[Tom Ogilvy]

'Take number off string, add 100 then put back the value as a new

string

For r = 1 To UBound(SourceArr, 1)
TempVal = SourceArr(r, 1)
SourceArr(r, 1) = "'" & Mid(TempVal, 1)
Next r

Which part of the code does what you describe?

What is mid doing for you:

tempval = "ABCDEFGH"
? mid(tempval,1)
ABCDEFGH

might as well remove Mid if you are hyped on speed.

--
Regards,
Tom Ogilvy

Altenrative You may consider to use an array of the datatype
variant like the following:
Code:
--------------------

Option Explicit

Sub Perhaps_Faster()
Dim rnData As Range
Dim vaData As Variant
Dim i As Long

Set rnData = Range(Range("B2"), Range("B65536").End(xlUp))

vaData = rnData.Value

For i = 1 To UBound(vaData)
vaData(i, 1) = Left(vaData(i, 1), 4)
Next i

rnData.Value = vaData

End Sub
--------------------


Kind regards,
Dennis

Thanks you all for your replay
i just found the way to do it!!

code:
-------------------------------------------------------------------------- -------
Dim SourceArr() As Variant, r As Long, TempVal

'Place data source into an array
SourceArr = Range("BH1:BH" & Range("A65536").End(xlUp).Row)

'Take number off string, add 100 then put back the value as a new
string

For r = 1 To UBound(SourceArr, 1)
TempVal = SourceArr(r, 1)
SourceArr(r, 1) = "'" & Mid(TempVal, 1)
Next r

'Place array into column BH
Range(Cells(1, 60), Cells(UBound(SourceArr, 1), 60)) = SourceArr
-------------------------------------------------------------------------- ---------

 

[stakar]

> 'Take number off string, add 100 then put back the value as
new

string

For r = 1 To UBound(SourceArr, 1)
TempVal = SourceArr(r, 1)
SourceArr(r, 1) = "'" & Mid(TempVal, 1)
Next r

Which part of the code does what you describe?

What is mid doing for you:

tempval = "ABCDEFGH"
? mid(tempval,1)
ABCDEFGH

might as well remove Mid if you are hyped on speed.

--
Regards,
Tom Ogilvy


'Return the value as a string with the quote "'"
Thats the comment i wanted to add instead of
'Take number off string, add 100 then put back the value as ne
string'


By the way about the mid you are right , i removed that , it wa
useless!!

Thanks To