Macro to copy data containing numeric values

I would like a macro to copy data containing numeric values from Col K to J for eg 4201K, W4250 etc

I am battling to upload the sample data where I highlighted the numeric data in Col K that must be copied to Col J


I have code to do this, but it does nothing

Code:

---

Sub Copy_Data()
Dim sh As Worksheet, lr As Long, rng As Range, c As Range
Set sh = Sheets(1)
lr = sh.Cells.Find("*", sh.Range("A1"), xlValues, xlPart, xlByRows, xlPrevious).Row
Set rng = sh.Range("K2:K" & lr)
    For Each c In rng
        If IsNumeric(Left(c.Value, 1)) Then
            c.Copy sh.Cells(Rows.Count, "J").End(xlUp)(2)
        End If
    Next
End Sub

---

Your assistance in resolving this is most appreciated

Missed the attachment

Hi Excel Fox

After I select Manage attachments, I select browse, Upload data and add files and after waiting 10 minutes , it is still trying to upload a 9 kb file. It would be appreciated if you could assist me

Flupsie

You are defining last row using the data in column A. Does Column A have any data in it?

I modified your code slightly, made sure that there was data in column A and it works.

Code:

---

Sub Copy_Data()
Dim sh As Worksheet, lr As Long, rng As Range, c As Range
Set sh = Sheets(1)
lr = sh.Range("A" & Rows.Count).End(xlUp).Row
Set rng = sh.Range("K2:K" & lr)
    For Each c In rng
        If IsNumeric(Left(c.Value, 1)) Then
            c.Copy sh.Cells(Rows.Count, "J").End(xlUp)(2)
        End If
    Next
End Sub

---

Hi Alansidman

Thanks for the help, much appreciated. For some unknown reason , I cannot upload my sample data. I select manage attachments> add files> Browse to select the workbook> upload data, but the files are not uploaded. It may have to do with a setting on my PC. It would be appreciated if you can assist

The macro is copying the numeric data from Col K to Col J but after the last item in Col J. What I want the macro to do, is that where there is a number value for eg 2507K in K5 then thismust be copied to J5 etc

Your assistance in this regard is most appreciated

Flupsie, what is the file type that you are uploading?

Can you upload the file on to any filesharing site, and post the link here?

Hi Excel Fox. It is an xlsb file. I selected manage attachments> add files> Browse to select the workbook> upload data, but the files are not uploaded

It may have to do with Internet security or possibly my MacAfee ACG that is causing the problem

I am busy downloading drop box and will post the link soon

Flupsie

Hi Excel Fox & Alan

Please find link to drop box below

https://www.dropbox.com/s/86kl3jyctw...ic%20Data.xlsx

Flupsie

Try this

Code:

---

Sub ExcelFox()

    Dim rng As Range
    Dim rngEach As Range
    With Worksheets("Sheet1")
        Set rng = .Range("K2", .Cells(.Rows.Count, "K").End(xlUp))
    End With
    For Each rngEach In rng
        If HasNumber(rngEach.Value) Then
            rngEach(, 0).Value = rngEach.Value
        End If
    Next rngEach
End Sub

Private Function HasNumber(varValue As Variant) As Boolean

    HasNumber = Evaluate("MAX(IFERROR(FIND({""0"",""1"",""2"",""4"",""5"",""6"",""7"",""8"",""9""},""" & varValue & """),0))")
   
End Function

---

A slightly more slower, but shorter one that uses the same technique. Replace the line in the HasNumber function with the following. Note: Though it looks shorter, the original code should be faster. Having said that, if the data isn't too large, then the difference should be very minimal.

Code:

---

HasNumber = Evaluate("MAX(IFERROR(FIND(ROW(1:10)-1,""" & varValue & """),0))")

---

EDIT: Note that this will only work in Excel 2007 and above because I've used the IFERROR function. If you are familiar with formulas, and you want to make it compatible with Excel 2003 and before, just modify the above formula. Post back in case you are using an older version of Excel, not sure how to edit the formula I've used.

Hi Excel Fox

Thanks it works perfectly

Flupsie