Copy data from another workbook and Trim

[Emperor]

Hi all,

Im trying to copy data from another workbook and then trim the data with VBA.

Dim myFile As Workbook
Dim folder As String

Dim ws As Worksheet

Set ws = Worksheets("Blad1") 'doelblad

folder = ThisWorkbook.Path & "\"
Set myFile = Workbooks.Open(folder & "toelichting.xls")

myFile.Sheets("Sheet0").Range("A:B").Copy

ws.Range("A1").PasteSpecial Paste:=xlPasteValues

'Clipboard empty
Application.CopyObjectsWithCells = False

'close doc
myFile.Close False

Copy works very well, but now the hard part.
In Column A I have data what needs to be trimmed. There are multirow memo-fields from a database program. Somewhere in the middle there is "regio : #".

I need that # for every row!

In formula i have in C3 for cell A1:
=IF(A1="","",TRIM(CLEAN(MID(A1,(SEARCH("regio",A1))+8,2))))

The '+8' is to skip the 'regio : '

Could somebody help me?

The data in Column A can/could be deleted while it's copied and I only need that number!

Mathijs

 

[AlphaFrog]

Sub regio_numbers()

    Dim Lastrow As Long
    
    [COLOR="Green"]' Suspend screen updating[/COLOR]
    Application.ScreenUpdating = False
    
    [COLOR="Green"]' Last used row in column A[/COLOR]
    Lastrow = Range("A" & Rows.Count).End(xlUp).Row
    
    [COLOR="Green"]' Formula in column C for each cell in column A (extracts regio numbers if found)[/COLOR]
    Range("C1:C" & Lastrow).FormulaR1C1 = "=IF(ISNUMBER(SEARCH(""regio"",RC1)),TRIM(CLEAN(MID(RC1,(SEARCH(""regio"",RC1))+8,2))),"""")"
    
   [COLOR="Green"] ' Copy values from column C to column A[/COLOR]
    Range("A1:A" & Lastrow).Value = Range("C1:C" & Lastrow).Value
    
    [COLOR="Green"]' Clear column C[/COLOR]
    Range("C1:C" & Lastrow).ClearContents
    
    Application.ScreenUpdating = True
    
End Sub