VBA from text to number

[Sophia]

Hi Guys,

I need to crete macros to exctract (1) and (702) numbers without brakets from this text, converted it to 702_1 format and change sheet name to 702_1 automatically.

text is on the same sheet which need to be changed. (several sheets like that not one)

current sheet name is Sheet1, Sheet2,...

No other numbers in text

Is it possible?

[Paul_Hossler]

Q: You need to create a macro to extract the '1' and the '708' part of '(1)' and '(708)' without the parentheses, and rename the worksheet to '702_1' ?

Where did the (1), the (708), and the '702_1' come from?

A lot more information and detail would be helpful

[Sophia]

Soory my bad I adjusted the message just typing error

[Paul_Hossler]

And the additional details?

Where is the text? (e.g. A1)

Always in the same place?

What does the rest of (the cell???) text look like? (e.g. "Sometext (1) and some more (702) and still some more")

[Sophia]

Text is in A6 always in same place in all sheets
this report is from sytem

these are 3 examples of text

Fund: UNRESTRICTED FUND (1), Department: MATCHING GIFT (722)
Fund: UNRESTRICTED FUND (1), Department: HALL OF FAME DINNER (720)
Fund: TEMPORARILY RESTRICTED FUND (2), Department: PIRO GENERAL SCHOLARSHIP (905)

[Sophia]

oh God

Fund: PERMANENTLY RESTRICTED FUND (3), Department: CLASS OF 1988 MEMORIAL FACULTY ENRICHMENT ENDOW (979)

I have example like this where 1988 is the just name of the class which I dont need

I need department code_fund code
department code is always at the end

[Sophia]

seems tsk is really difficult

[SamT]

Option Explicit

Sub Rename_Dept_Fund_Sheets()
'This will skip any Sheet with an A6 String that does not have exactly 2 complete sets of parentheses
'Example: Fund: UNRESTRICTED FUND 1), Department: HALL OF FAME DINNER (720)
'Example: Fund: UNRESTRICTED FUND 1, Department: HALL OF FAME DINNER (720)
'Example: Fund: UNRESTRICTED FUND(1), Department(#3): HALL OF FAME DINNER (720)

Dim FundNum As String
Dim DeptNum As String
Dim X As Variant
Dim Sht As Worksheet

For Each Sht In ActiveWorkbook.Sheets
   If Not InStr(Sht.Range("A6"), ")") = 2 Then GoTo NextSht 'Note the last close Paren is part of InStr()
   If Not InStr(Sht.Range("A6"), "(") = 2 Then GoTo NextSht 
   On Error GoTo NextSht

    X = Split(Sht.Range("A6"), "(") 'pay attention to the structure of Split. The last Close Paren is part of Split()
   FundNum = Split(X(1), ")")(0) 'X(1) is the second element of X, (0) is the first element of Split
   DeptNum = Split(X(2), ")")(0) 'X(2) is the third element of X, (0) is the first element of Split
   Sht.Name = DeptNum & "_" & FundNum
NextSht:
Next Sht

End Sub

I recommend you place this code in a module in the "Personal" Workbook and run it from the Macro menu in the workbook you want to rename the sheets in.

[Paul_Hossler]

Not difficult at all

Option Explicit


Sub Do_Dept_Fund()
    Dim ws As Worksheet
    Dim sNewName As String
    
    For Each ws In Worksheets
        sNewName = Dept_Fund(ws.Range("A6").Value)
        
        If Len(sNewName) > 0 Then ws.Name = sNewName
    Next


End Sub




Private Function Dept_Fund(s As String) As String
    Dim p1 As Long, p2 As Long, p3 As Long, p4 As Long
    
    p1 = 0
    p2 = 0
    p3 = 0
    p4 = 0
    
    On Error GoTo NoCanDo
    p1 = InStr(1, s, "(", vbBinaryCompare)
    p2 = InStr(1, s, ")", vbBinaryCompare)
    p3 = InStr(p1 + 1, s, "(", vbBinaryCompare)
    p4 = InStr(p2 + 1, s, ")", vbBinaryCompare)
    
    Dept_Fund = Mid(s, p3 + 1, p4 - p3 - 1) & "_" & Mid(s, p1 + 1, p2 - p1 - 1)
    On Error GoTo 0


    Exit Function
    
NoCanDo:
    Dept_Fund = vbNullString


End Function

[Sophia]

Thanks Paul I am able to run it

[Paul_Hossler]

The modified version I just updated -- FundDept_1.xlsm -- is a little better

I started thinking worksheet functions, and didn't reset my all of mental gears to stay with a simpler VBA approach

You can mark your post SOLVED -- #3 in my sig

[Paul_Hossler]

@SamT -

I'm always looking to learn, but are you sure this is correct?

   If Not InStr(Sht.Range("A6"), ")") = 2 Then GoTo NextSht 'Note the last close Paren is part of InStr()
   If Not InStr(Sht.Range("A6"), "(") = 2 Then GoTo NextSht

I tried your macro in the sample WB I used, but nothing happens

For

A6 = "Fund: UNRESTRICTED FUND (1), Department: MATCHING GIFT (722)"

Instr(A6, "(" = 25

Were you thinking of counting the )'s ?

[SamT]

Were you thinking of counting the )'s ?

And of course, I wrote the Edge Case error checking after testing the basic functionality.

This works

Dim FundNum As String
Dim DeptNum As String
Dim X As Variant
Dim Sht As Worksheet

For Each Sht In ActiveWorkbook.Sheets
   On Error GoTo NextSht
   X = Split(Sht.Range("A6"), "(") 'pay attention to the structure of Split. The last Close Paren is part of Split()
   FundNum = Split(X(1), ")")(0) 'X(1) is the second element of X, (0) is the first element of Split
   DeptNum = Split(X(2), ")")(0) 'X(2) is the third element of X, (0) is the first element of Split
   Sht.Name = DeptNum & "_" & FundNum
NextSht:
Next Sht

End Sub

[SamT]

Were you thinking of counting the )'s ?

And of course, I wrote the Edge Case error checking after testing the basic functionality.
thank you for that little reminder.

This works

Dim FundNum As String
Dim DeptNum As String
Dim X As Variant
Dim Sht As Worksheet

For Each Sht In ActiveWorkbook.Sheets
   On Error GoTo NextSht
   X = Split(Sht.Range("A6"), "(") 'pay attention to the structure of Split. The last Close Paren is part of Split()
   FundNum = Split(X(1), ")")(0) 'X(1) is the second element of X, (0) is the first element of Split
   DeptNum = Split(X(2), ")")(0) 'X(2) is the third element of X, (0) is the first element of Split
   Sht.Name = DeptNum & "_" & FundNum
NextSht:
Next Sht

End Sub

I shudda left it at that

[Sophia]

Yes it is wow thank you guys.
I am really appreciate