Excel VBA code for MID/Splitting text in cell based on fixed width - vba

Question

I apologize if there is already the same question asked elsewhere with an answer however I have been unable to find it so here I go.
I will also mention that I am a VBA beginner, mostly playing around with codes obtained from other people to get what I want.
I currently have data in Columns A-D, with the information in column C being the important column. Everything else should be ignored.
I have a line of text in cell C1 of sheet1. It is 25 characters long and resembles the following:
4760-000004598700000000000
I have over ~970,000 rows of data and need to pull out the information found within each of these cells into two different cells in another sheet.
I cannot simply use a formula due to the number of records (excel crashes when I try).
If using the mid function for C1, I would enter something like (C1,2,3) and (C1,5,11). (except it would be for each cell in column C)
The leading zeroes between the + or - and the beginning of the first non-zero value are of no consequence but I can fix that part on my own if need be.
Ideally the information would be pulled into an existing sheet that I have prepared, in the A and B columns. (IE:sheet2)
For example, using the text provided above, the sheet would look like:
A|B
760|-0000045987 or -45987
I have looked into array, split and mid codes but I had troubles adapting them to my situation with my limited knowledge of VBA. I am sure there is a way to do this and I would appreciate any help to come up with a solution.
Thank you in advance for your help and please let me know if you need any additional information.

Answer 1

It sounds like what you're after could be achieved by the Text to Columns tool. I'm not sure whether you're trying to include this as a step in an existing macro, or if this is all you want the macro to do, so I'll give you both answers.
If you're just looking to split the text at a specified point, you can use the Text to Columns tool. Highlight the cells you want to modify, then go to the Data tab and select "Text to Columns" from the "Data Tools" group.
In the Text to Columns wizard, select the "Fixed Width" radio button and click Next. On step 2, click in the data preview to add breaks where you want the data to be split - so, in the example you gave above, click between "760" and "-". Click Next again.
On step 3, you can choose the format of each column that will result from the operation. This is useful with the leading zeroes you mentioned - you can set each column to "Text". When you're ready, click Finish, and the data will be split.
You can do the same thing with VBA using a fairly simple bit of code, which can be standalone or integrated into a larger macro.
Sub RunTextToColumns()
Dim rngAll As Range
Set rngAll = Range("A1", "A970000")
rngAll.TextToColumns _
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(3, 2))
With Sheets("Sheet4").Range("A1", "A970000")
.Value = Range("A1", "A970000").Value
.Offset(0, 1).Value = Range("B1", "B970000").Value
End With
End Sub
This takes around a second to run, including the split and copying the data. Of course, the hard-coded references to ranges and worksheets are bad practice, and should be replaced with either variables or constants, but I left it this way for the sake of clarity.

Answer 2

How about this:
Sub GetNumbers()
Dim Cel As Range, Rng As Range, sCode As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Rng = Sheets("Sheet1").Range("C1:C" & Sheets("Sheet1").Range("C1048576").End(xlUp).Row)
For Each Cel In Rng
Sheets("Sheet2").Cells(Cel.Row, 1).Value = Mid(Cel.Value, 2, 3)
sCode = Mid(Cel.Value, 5, 11)
'Internale loop to get rid of the Zeros, reducing one-by-one
Do Until Mid(sCode, 2, 1) <> "0" And Mid(sCode, 2, 1) <> 0
sCode = Left(sCode, 1) & Right(sCode, Len(sCode) - 2)
Loop
Sheets("Sheet2").Cells(Cel.Row, 2).Value = sCode
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Answer 3

I think there's an array formula thing that would do this, but I prefer the brute force approach. There are two ways to fill in the fields, with a procedure or with a function. I've done both, to illustrate them for you. As well, I've purposely used a number of ways of referencing the cells and of separating the text, to illustrate the various ways of achieving your goal.
Sub SetFields()
Dim rowcounter As Long, lastrow As Long
lastrow = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row 'get the last row in column "C"
For rowcounter = 1 To lastrow 'for each row in the range of values
'put the left part in column "D"
ActiveSheet.Range("D" & rowcounter) = FieldSplitter(ActiveSheet.Cells(rowcounter, 3).Text, True)
'and the right part in the column two over from colum "C"
ActiveSheet.Cells(rowcounter, 3).Offset(0, 2) = FieldSplitter(ActiveSheet.Cells(rowcounter, 3).Text, False)
Next rowcounter
End Sub
Function FieldSplitter(FieldText As String, boolLeft As Boolean) As String
If boolLeft Then
FieldSplitter = Mid(FieldText, 2, 3) 'one way of getting text from a string
Else
FieldSplitter = Left(Right(FieldText, 16), 5) ' another way
End If
'Another useful function is Split, as in myString = Split (fieldtext, "-")(0) This would return "4760"
End Function