macro to remove dot . between numbers and make numbers to 8 digits with overlapping empty rows

[RAM72]

Macro to remove dot (.) between numbers and the numbers to read 8 digits in a column still end of data

There are two types of data to convert in

See attached

 

[Chihiro]

It can be easily done via Formula (added col C & G), see attached.

VBA code below. Not the most efficient, but will do what you are looking for.

Sub SplitConc()
Dim lRow As Long
Dim nString As String
Dim rString As String

lRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row

For Each cel In Sheet1.Range("A2:A" & lRow)
    nString = Replace(cel.Text, ".", "")
    If Len(nString) > 0 Then
        rString = Application.WorksheetFunction.Rept("0", 7 - Len(nString))
        nString = "0" & nString & rString
        cel.Offset(0, 1).NumberFormat = "@"
        cel.Offset(0, 1) = nString
    Else
    End If
Next cel

lRow = Sheet1.Range("E" & Rows.Count).End(xlUp).Row

For Each cel In Sheet1.Range("E2:E" & lRow)
    nString = Replace(Round(cel.Value, 2), ".", "")
    If nString <> 0 Then
        rString = Application.WorksheetFunction.Rept("0", 8 - Len(nString))
        nString = nString & rString
        cel.Offset(0, 1).NumberFormat = "@"
        cel.Offset(0, 1) = nString
    Else
    End If
Next cel

End Sub

I assumed you wanted "ht code" rounded to 2nd decimal place based on your expected results.

 

[jindon]

Try

Sub test()
    Dim e
    For Each e In Array("a", "d")
        With Range(e & "2", Range(e & Rows.Count).End(xlUp))
            .Offset(, 1).Value = Evaluate("if(" & .Address & "<>"""",if(" & _
            .Address & "<1000,""'"","""")&text(" & _
            .Address & "*10000,rept(""0"",8)),"""")")
        End With
    Next
End Sub

 

[Chihiro]

Nice code. I've got to learn Array and how to use formula in VBA. I often mess up quotation use and give up.

 

[RAM72]

Try

Sub test()
    Dim e
    For Each e In Array("a", "d")
        With Range(e & "2", Range(e & Rows.Count).End(xlUp))
            .Offset(, 1).Value = Evaluate("if(" & .Address & "<>"""",if(" & _
            .Address & "<1000,""'"","""")&text(" & _
            .Address & "*10000,rept(""0"",8)),"""")")
        End With
    Next
End Sub

Thank you Jindon

Working perfectly

 

[RAM72]

It can be easily done via Formula (added col C & G), see attached.

VBA code below. Not the most efficient, but will do what you are looking for.

Sub SplitConc()
Dim lRow As Long
Dim nString As String
Dim rString As String

lRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row

For Each cel In Sheet1.Range("A2:A" & lRow)
    nString = Replace(cel.Text, ".", "")
    If Len(nString) > 0 Then
        rString = Application.WorksheetFunction.Rept("0", 7 - Len(nString))
        nString = "0" & nString & rString
        cel.Offset(0, 1).NumberFormat = "@"
        cel.Offset(0, 1) = nString
    Else
    End If
Next cel

lRow = Sheet1.Range("E" & Rows.Count).End(xlUp).Row

For Each cel In Sheet1.Range("E2:E" & lRow)
    nString = Replace(Round(cel.Value, 2), ".", "")
    If nString <> 0 Then
        rString = Application.WorksheetFunction.Rept("0", 8 - Len(nString))
        nString = nString & rString
        cel.Offset(0, 1).NumberFormat = "@"
        cel.Offset(0, 1) = nString
    Else
    End If
Next cel

End Sub

I assumed you wanted "ht code" rounded to 2nd decimal place based on your expected results.

Thank you Chindon

Perfect