VBA: Text To Columns then Add Formula

[nickshep85]

Hi All,

I'm quite new to VBA and am building a messy code to help me with some large text files. I have the first part of my code to import the text file into as many sheets as necessary, but I'm coming unstuck on the second part.

I have a code to run a Text to Columns (TTC) function (comma delimited) on as many sheets as there are in my file (PriceFile.xls). I then need to add a formula in to see if the cell in Column A begins with a number and return TRUE/FALSE. My code runs the TTC function on both sheets that are in my file, but only inputs the formula into the first available sheet. Can anyone please help point out my mistakes and tell me how to fix this?

Sub Text_to_Column()
'Application.ScreenUpdating = False

Workbooks("PriceFile").Activate

Dim ws As Worksheet
    On Error Resume Next
    For Each ws In Worksheets
        ws.Range("A:A").TextToColumns Destination:=ws.Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
        FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
        
    Dim LastRow As Long
    LastRow = Cells.Find(What:="*", _
    searchdirection:=xlPrevious, _
    SearchOrder:=xlByRows).Row
    
    Range("I1:I" & LastRow).FormulaR1C1 = "=ISERROR(SEARCH(LEFT(RC[-8],1),""1234567890"",1))"
    Application.CutCopyMode = False

    
    Next ws
    
'Application.ScreenUpdating = True

End Sub

Many thanks for your help.

 

[VoG]

Try

Sub Text_to_Column()
'Application.ScreenUpdating = False

Workbooks("PriceFile").Activate
Dim LastRow As Long

Dim ws As Worksheet
On Error Resume Next
For Each ws In Worksheets
    With ws
        .Range("A:A").TextToColumns Destination:=.Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
        FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
        
        LastRow = .Cells.Find(What:="*", _
        searchdirection:=xlPrevious, _
        SearchOrder:=xlByRows).Row
        
        .Range("I1:I" & LastRow).FormulaR1C1 = "=ISERROR(SEARCH(LEFT(RC[-8],1),""1234567890"",1))"
        Application.CutCopyMode = False
    End With
    
Next ws

'Application.ScreenUpdating = True

End Sub

 

[Weaver]

Range("I1:I" & LastRow).FormulaR1C1

needs to refer to the relevant sheet

ws.Range("I1:I" & LastRow).FormulaR1C1

otherwise it just keeps applying the formula to the active sheet.

HTH

 

[nickshep85]

Try

Sub Text_to_Column()
'Application.ScreenUpdating = False

Workbooks("PriceFile").Activate
Dim LastRow As Long

Dim ws As Worksheet
On Error Resume Next
For Each ws In Worksheets
    With ws
        .Range("A:A").TextToColumns Destination:=.Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
        FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
        
        LastRow = .Cells.Find(What:="*", _
        searchdirection:=xlPrevious, _
        SearchOrder:=xlByRows).Row
        
        .Range("I1:I" & LastRow).FormulaR1C1 = "=ISERROR(SEARCH(LEFT(RC[-8],1),""1234567890"",1))"
        Application.CutCopyMode = False
    End With
    
Next ws

'Application.ScreenUpdating = True

End Sub

Thanks, this worked just as I needed it.

Was it just the Dim LastRow as Long (moved) and With ws (added) that were changed, just so that I can learn from my mistakes?

 

[VoG]

It is the With ws that did it. Otherwise you were referring to the active sheet as Weaver said.

 

[nickshep85]

Thanks, hopefully this will stick in my mind when I need it next time.

I have a feeling that I will be back here very soon for the next part of my code, copying rows to a new sheet, but I'm hoping I can butcher my way through it first.

Thanks again.