VBA if cell contain text

[Sparda142]

Hello,

I'm trying to create a VBA that states if within Column A if there is a text then paste to the right. If the cell in column A has a numeric value then do nothing.


[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]a[/TD]
[TD]b[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]john[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]3[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]jake[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]bill[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]7[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[igold]

Does this do what you want...

Sub test()
    Dim rng As Range, i As Long
    Set rng = Range("A2:B" & Cells(Rows.Count, 1).End(xlUp).Row)
    For i = 1 To rng.Cells.Count Step 2
        With rng
            If Not IsNumeric(.Cells(i).Value) Then .Cells(i + 1) = .Cells(i).Value
        End With
    Next
End Sub

 

[Sparda142]

Does this do what you want...

Sub test()
    Dim rng As Range, i As Long
    Set rng = Range("A2:B" & Cells(Rows.Count, 1).End(xlUp).Row)
    For i = 1 To rng.Cells.Count Step 2
        With rng
            If Not IsNumeric(.Cells(i).Value) Then .Cells(i + 1) = .Cells(i).Value
        End With
    Next
End Sub

Didn't work

 

[My Aswer Is This]

I tested the code and it worked.
How did it not work for you?

Explain what it did do.

Didn't work

 

[igold]

Other than perhaps that as per your graphic the range should have correctly started at "A1" and not "A2", as My Aswer asked, what happened...

 

[My Aswer Is This]

Here is how I would write the code:

Sub My_Sub()
'Modified  8/6/2019  5:27:34 PM  EDT
Dim i As Long
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    For i = 1 To Lastrow
        If Not IsNumeric(Cells(i, 1).Value) Then Cells(i, 2).Value = Cells(i, 1).Value
    Next
End Sub

 

[igold]

@ My Aswer,

Just for shiggles, I ran my test data out to 250k rows of data (I meant to go 100k, but was talking to someone and forgot to let go of the mouse button). On my machine our first two codes completed in about 12.3 seconds.

The code below did it in ¼ seconds.

Sub test2()
    Dim arr, i As Long
    arr = Range("A1:B" & Cells(Rows.Count, 1).End(xlUp).Row)
    For i = LBound(arr) To UBound(arr)
            If Not IsNumeric(arr(i, 1)) Then arr(i, 2) = arr(i, 1)
    Next
    Range("A1").Resize(UBound(arr, 1), 2) = arr
End Sub

 

[Rick Rothstein]

Here is a macro that does not use a loop...

Sub CopyTextOnly()
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Application.ScreenUpdating = False
  Range("B1:B" & LastRow).Value = Range("A1:A" & LastRow).Value
  Columns("B").SpecialCells(xlConstants, xlNumbers).Clear
  Application.ScreenUpdating = True
End Sub

@igold... Do you still have your test setup? If so, I would be interested to know the execution time of the above code.

 

[igold]

Hi Rick,

Ran it twice, ~49 seconds both times.

As a check, ran the other code right after to make sure that the machine was not busy somewhere else and got the same results...

 

[Rick Rothstein]

Hi Rick,

Ran it twice, ~49 seconds both times.

As a check, ran the other code right after to make sure that the machine was not busy somewhere else and got the same results...

Yeah, I thought copying all the data over then filtering might slow things down, but I didn't think it would do so that adversely. Thanks for doing the test.