none
VBA code for replacing spaces in a field with a previous field's number RRS feed

  • Question

  • Hello

    We are using excel 2013 and we have two questions.

    1. Can someone provide some code for looping through rows of data in a column field and if a number is found leave it alone but if the next row in that column field contains spaces then copy the previous number in that field? The number of rows in the file always changes from week to week. 

    The very first row will have spaces in it and there can be 8 to 10 blank rows (no data) before the first number starts. After that there are multiple rows of the same number with rows of spaces intermixed before the next number starts.

    As an example the data is as follows in the column field

    blank row  (no data). There can be 8 to 10 of these before the first number starts. 

    025001210

    spaces (no data)

    spaces (no data)

    025001210

    025001310

    spaces (no data)

    025001310

    spaces (no data)

    025001310

    025001310

    029000069

    029000069

    2. Can someone provide some code that copies the last 4 digits in a field to another field?

    Thanks

    Friday, June 1, 2018 3:44 PM

Answers

  • Try the following code. Because your numbers contain a leading zero, I have assumed that they are in Text format and therefore I have kept it all in text format.

    See second macro to copy last 4 digits at bottom of this post.

    Sub Macro1()
        Dim ws As Worksheet
        Dim rngData As Range
        Dim rCel As Range
        Dim varLastVal As Variant
       
        Set ws = Worksheets("Sheet1")   'Edit "Sheet1" to your worksheet name
       
        With ws
            Set rngData = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
           
            'Suppress text numbers being converted to numeric format
            rngData.NumberFormat = "@"
           
            For Each rCel In rngData
                'Find first cell with numeric data
                'Note the VBA function IsNumeric sees blank cell as numeric
                'Hence using the Worksheet Function
                If Trim(rCel.Value) <> "" Then
                    varLastVal = rCel.Value
                    Exit For
                End If
            Next rCel
           
            'Re-set rngData to new range commencing at
            'cell immediately after the first found numeric cell
            Set rngData = .Range(rCel.Offset(1, 0), .Cells(.Rows.Count, "A").End(xlUp))
           
            For Each rCel In rngData
                'If cell not spaces then save the cells value
                If Trim(rCel.Value) <> "" Then
                    varLastVal = rCel.Value
                Else
                    'If cell only has spaces then insert last value
                    rCel.Value = varLastVal
                End If
            Next rCel
        End With
       
    End Sub

    The following code will copy the last 4 digits in a field to another field.

    Note there are 2 options. The first option will convert the text number to a real number.

    The second option will retain the number in text format.

    Sub Macro2()
        Dim ws As Worksheet
       
        Set ws = Worksheets("Sheet1")   'Edit "Sheet1" to your worksheet name
       
        With ws
            'Option 1:
            'If copying to cell with General number format then the following line
            'will convert a text numeric to normal numeric
            'Note: .Cells(14, "B") is the destination cell
            .Cells(14, "B").Value = Right(.Cells(14, "A").Value, 4)
           
            'Option 2:
            'The following 2 lines will ensure that a text numeric remains text numeric
            '.Cells(14, "B").NumberFormat = "@"
            '.Cells(14, "B").Value = Format(Right(.Cells(14, "A").Value, 4), "0000")
        End With
    End Sub


    Regards, OssieMac

    • Proposed as answer by Terry Xu - MSFT Tuesday, June 5, 2018 3:05 AM
    • Marked as answer by Hotmail1 Friday, July 6, 2018 2:35 PM
    Sunday, June 3, 2018 4:10 AM
  • Hi Hotmail1,

    Do you have any issue with this thread?

    If not, I would suggest you mark the helpful reply as answer which is the way to close a thread here.

    If you do, please feel free to let us know.

    Best Regards,

    Tao Zhou


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    • Marked as answer by Hotmail1 Friday, July 6, 2018 2:35 PM
    Thursday, June 7, 2018 7:25 AM

All replies

  • Try the following code. Because your numbers contain a leading zero, I have assumed that they are in Text format and therefore I have kept it all in text format.

    See second macro to copy last 4 digits at bottom of this post.

    Sub Macro1()
        Dim ws As Worksheet
        Dim rngData As Range
        Dim rCel As Range
        Dim varLastVal As Variant
       
        Set ws = Worksheets("Sheet1")   'Edit "Sheet1" to your worksheet name
       
        With ws
            Set rngData = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
           
            'Suppress text numbers being converted to numeric format
            rngData.NumberFormat = "@"
           
            For Each rCel In rngData
                'Find first cell with numeric data
                'Note the VBA function IsNumeric sees blank cell as numeric
                'Hence using the Worksheet Function
                If Trim(rCel.Value) <> "" Then
                    varLastVal = rCel.Value
                    Exit For
                End If
            Next rCel
           
            'Re-set rngData to new range commencing at
            'cell immediately after the first found numeric cell
            Set rngData = .Range(rCel.Offset(1, 0), .Cells(.Rows.Count, "A").End(xlUp))
           
            For Each rCel In rngData
                'If cell not spaces then save the cells value
                If Trim(rCel.Value) <> "" Then
                    varLastVal = rCel.Value
                Else
                    'If cell only has spaces then insert last value
                    rCel.Value = varLastVal
                End If
            Next rCel
        End With
       
    End Sub

    The following code will copy the last 4 digits in a field to another field.

    Note there are 2 options. The first option will convert the text number to a real number.

    The second option will retain the number in text format.

    Sub Macro2()
        Dim ws As Worksheet
       
        Set ws = Worksheets("Sheet1")   'Edit "Sheet1" to your worksheet name
       
        With ws
            'Option 1:
            'If copying to cell with General number format then the following line
            'will convert a text numeric to normal numeric
            'Note: .Cells(14, "B") is the destination cell
            .Cells(14, "B").Value = Right(.Cells(14, "A").Value, 4)
           
            'Option 2:
            'The following 2 lines will ensure that a text numeric remains text numeric
            '.Cells(14, "B").NumberFormat = "@"
            '.Cells(14, "B").Value = Format(Right(.Cells(14, "A").Value, 4), "0000")
        End With
    End Sub


    Regards, OssieMac

    • Proposed as answer by Terry Xu - MSFT Tuesday, June 5, 2018 3:05 AM
    • Marked as answer by Hotmail1 Friday, July 6, 2018 2:35 PM
    Sunday, June 3, 2018 4:10 AM
  • Hi Hotmail1,

    Do you have any issue with this thread?

    If not, I would suggest you mark the helpful reply as answer which is the way to close a thread here.

    If you do, please feel free to let us know.

    Best Regards,

    Tao Zhou


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    • Marked as answer by Hotmail1 Friday, July 6, 2018 2:35 PM
    Thursday, June 7, 2018 7:25 AM