CODEWITHSUNDEEP
vbaexcel
C. Morett
C. Morett

Reputation: 45

Sort by character count, replacing strings

I have a list that looks like

Col A

  1. FU010402350000
  2. FU0366090000
  3. FU0023750000
  4. FU010587090000
  5. FU0368420000
  6. FU010671340000

Everyday it needs sorting, the character count for a real string value is 14 characters, so the ones that are 14 characters are correct, but the 12 character strings need editing to become 'real'.

The thing is, it needs to have 00 at the beginning, after FU.

My train of thought is

If < 12 characters add 00 after FU, otherwise if it's 14 characters ignore cell

How can I set up a macro to filter by character count, replace values if it isn't < 12?

Here is my start

Sub charactercountfilter()

' Get rownumber of lastrow of data Col A
lastrow = Range("a65536").End(xlUp).Row

' Check row 1 to last row #, Col A
For i = 1 To lastrow
    ' If less than 12 chars
    If Len(Cells(i, 1)) < 12 Then
        ' ...
Next i

End Sub

Upvotes: 0

Views: 108

Answers (2)

Scott Craner
Scott Craner

Reputation: 152505

This will be quicker as it works with a variant array and only accesses the worksheet twice:

Sub FU0014character()
Dim ws As Worksheet
Set ws = Worksheets("Sheet12") 'Change to your sheet or ActiveSheet

Dim rng As Range
Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(ws.Rows.Count, 1).End(xlUp))

Dim arr As Variant
arr = rng.Value

Dim i As Long
For i = 1 To UBound(arr, 1)
    arr(i, 1) = Left$(arr(i, 1), 2) & Format(Val(Mid$(arr(i, 1), 3)), "000000000000")
Next i

rng.Value = arr
End Sub

Upvotes: 2

C. Morett
C. Morett

Reputation: 45

Sub FU0014character()
'
' selectbinsertcolumn Macro
'
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

' Get rownumber of lastrow of data Col A
lastrow = Range("a65536").End(xlUp).Row

' Check row 1 to last row #, Col A
For i = 1 To lastrow
    ' If less than 14 chars
    If Len(Cells(i, 1)) < 14 Then
        ' Take data and apply it to right column
        Cells(i, 1) = Range(Cells(i, 1), Cells(i, 2)).FillRight

    End If
    ' Not less than 14 - get next row
Next i


Columns("B").Replace What:="FU", _
                        Replacement:="FU00", _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        MatchCase:=False, _
                        SearchFormat:=False, _
                        ReplaceFormat:=False

For i = 1 To lastrow
    ' If longer than 12 chars
    If Len(Cells(i, 1)) > 12 Then
        ' move to right
        Cells(i, 1) = Range(Cells(i, 1), Cells(i, 2)).FillRight

    End If
    ' Not less than 12 - get next row
Next i


Columns("A:A").Select
Selection.Delete Shift:=xlToLeft

End Sub

Basically what this does is, creates a new column (new column b) it then checks if Column A values character count is 14 characters, if it is less than 14 it will move it to the right, in the new column B.

Then it replaces every (12 character) in column B's FU with FU00.

It runs the column A check again, this time looking if it's greater than 12 and if they are (obviously, because they would've been moved at the first check), it will move it to the right in column B.

It then deletes the blank Column A.

Upvotes: 0

Related Questions