Copy Left Side of File Name

[jrtdcg]

Hi All,
I have a spreadsheet that is opening another spreadsheet. What I'd like to do is read the file name (Left side of decimal) that has been copied in a common cell reference, copy and paste the text to another cell in the other spreadsheet.

Spreadsheet 1-Copy from left side of decimal
cell A1: abc123.xlsm

Spreadsheet 2-Paste into A1
Cell A1; abc123

Hope that makes it simple enough to follow. Thanks...any help would be appreciated.

JR

 

[NeonRedSharpie]

Sub moveStuff()

    Dim wbS As Workbook
    Dim wsS As Worksheet
    
    Dim wbD As Workbook
    Dim wsD As Worksheet
    
    wbS = Workbooks("Worksheet 1") 'CHANGE ME
    wsS = wbS.Sheets("Sheet1") 'CHANGE ME
    
    wbD = ActiveWorkbook 'CHANGE ME
    wsD = ActiveSheet 'CHANGE ME
    


    With wsS.Cells(1, 1)
        wsD.Cells(1, 1) = Left(.Value, Find(".", .Value) - 1)
    End With




End Sub

This puts into A1 of the active sheet the value from A1 (left of period) from "Workbook 1"."Sheet1"

 

[Ragnar1211]

I was working on this the same time NeonRedSharpie posted, but i think there are a few syntax problems with that post, so here is an alternative solution:

Sub FileNm()

Dim wb1 As Workbook
Dim wb2 As Workbook

Dim sht1 As Worksheet
Dim sht2 As Worksheet

Dim Fname As String

'Name of Current open workbook with full filename change "Test.xlsm" to your source workbook name
    Set wb1 = Workbooks("Test.xlsm")

'Name of worksheet with filename - change sheet1 to your sheet name
    Set sht1 = wb1.Sheets("Sheet1")

'Name of Current open workbook that is the destination of the filename change "Test2.xlsm" to your destination workbook name
    Set wb2 = Workbooks("Test2.xlsm")

'Name of worksheet with filename - change sheet1 to your sheet name
    Set sht2 = wb2.Sheets("Sheet1")

'Determine the file name from a string that includes the extention
    Fname = sht1.Range("A1").Value
    Fname = StrReverse(Fname)
    Fname = StrReverse(Mid(Fname, InStr(1, Fname, ".") + 1, Len(Fname)))

'Put the name in the new cell
    sht2.Range("a1").Value = Fname

End Sub

 

[NeonRedSharpie]

I was working on this the same time NeonRedSharpie posted, but i think there are a few syntax problems with that post, so here is an alternative solution:

The only syntax problems are where I have 'CHANGE ME. Seeing as...he'll need to change them to be his actually workbook name and sheet name. And maybe that find isn't supported....

Sub moveStuff()

    Dim wbS As Workbook
    Dim wsS As Worksheet
    
    Dim wbD As Workbook
    Dim wsD As Worksheet
    
    wbS = Workbooks("Worksheet 1") 'CHANGE ME
    wsS = wbS.Sheets("Sheet1") 'CHANGE ME
    
    wbD = ActiveWorkbook 'CHANGE ME
    wsD = ActiveSheet 'CHANGE ME
    


    With wsS.Cells(1, 1)
        wsD.Cells(1, 1) = Left(.Value, Application.WorksheetFunction.Find(".", .Value) - 1)
    End With




End Sub

 

[Ragnar1211]

Sorry I didn't mean to offend

Syntax issue - You cannot use Find in VBA, have to use Instr instead.

Potential bug - Also, if you dont find the "." from the right side, you could run into the problem of a filename including a "." in it long before the file ext, eg "My.File.Here.xlsm"

Gerry

 

[NeonRedSharpie]

Sorry I didn't mean to offend

Syntax issue - You cannot use Find in VBA, have to use Instr instead.

Potential bug - Also, if you dont find the "." from the right side, you could run into the problem of a filename including a "." in it long before the file ext, eg "My.File.Here.xlsm"

Gerry

I'm never offended. But I did notice the find issue after you posted your comment. I didn't test the code because I didn't feel like opening a new workbook and naming the sheets.

 

[Ragnar1211]

NVM the syntax issue.. I just realized you were adding it as a formula... you win :P

 

[jrtdcg]

All,
Thank you so much for engaging in my question. I tried to be simple to some degree in my question, but I've posted my code below.

'Note that the code is in my personal macro toolbar
'1st Workbook is "Approval_Review.xlsm"
'Example for FileRef in cell A5 is 10102-10245 SubB.xlsm
'Here is what I use to add the file name to cell A5 on the 1st workbook

Range("A5").Select
    ActiveCell.FormulaR1C1 = "=LEFT(FileRef,25)"
    Range("A5").Select

------------------------------
'2nd-Workbook is "book1.xlsm"
'Current I'm just coping the A5 cell from the the 1st wookbook into cell A2 of the 2nd wookbook
'What I'd really like copied from A5 on 1st WB to cell A2 on the 2nd WB is "10102-10245 SubB"

Windows("Approval_Review.xlsm").Activate
    Range("A5").Select
    Selection.Copy
    Windows("book1.xlsx").Activate
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Font.Bold = True

Hope this helps to simplify my question. Thanks!

 

[Ragnar1211]

This assumes the worksheet names are Sheet1 for both books:

Sub FileNm2()

Dim wb1 As Workbook
Dim wb2 As Workbook

Dim sht1 As Worksheet
Dim sht2 As Worksheet

Dim Fname As String

'Name of Current open workbook with full filename change "Test.xlsm" to your source workbook name
    Set wb1 = Workbooks("Approval_Review.xlsm")

'Name of worksheet with filename - change sheet1 to your sheet name
    Set sht1 = wb1.Sheets("Sheet1")

'Name of Current open workbook that is the destination of the filename change "Test2.xlsm" to your source workbook name
    Set wb2 = Workbooks("book1.xlsx")

'Name of worksheet with filename - change sheet1 to your sheet name
    Set sht2 = wb2.Sheets("Sheet1")

'Determine the file name from a path including the filename
    Fname = sht1.Range("A5").Value
    Fname = StrReverse(Fname)
    Fname = StrReverse(Mid(Fname, InStr(1, Fname, ".") + 1, Len(Fname)))

'Put the name in the new cell
    sht2.Range("a2").Value = Fname

End Sub

 

[jrtdcg]

Works very well, Gerry. Thank you so much for your help in answering my question.