insert filename and sheet name with code

J

jordanburch

Active Member
Joined
Jun 10, 2016
Messages
440
Office Version
  1. 2016
hey guys i have the following code. I have tried several solutions but nothing seems to work. in column ad of wb2 i want the file name and the tab name to be inserted. They can be in different columns if that makes it easier. Any help is greatly appreciated.




If SheetExists(CStr(shArr(i)), wb2) Then
erow = ThisWorkbook.Sheets("DRP").Range("A" & Rows.Count).End(xlUp).Row + 1
With .Sheets(shArr(i))
If .AutoFilterMode = True Then .AutoFilterMode = False
wb2.Sheets(LCase(.Name)).Range("ad2:ad1000").Value = MyFile

If LCase(.Name) = "details" Then





.Range("D2:AF1000").Copy Destination:=ThisWorkbook.Worksheets("DRP").Cells(erow, 1)

Else

.Range("C2:AF1000").Copy Destination:=ThisWorkbook.Worksheets("DRP").Cells(erow, 1)

End If
End With


Jordan
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Sort by date Sort by votes
You need to be specific about what the problem is. I suspect you are trying to equate apples to oranges.
 
Upvote 0
What does 'MyFile' equate to? Full name including file path? Only Workbook namd plus file extension? Only workbook name? What?
If MyFile has not been initialized with a value, this line
VBA Code: 
wb2.Sheets(LCase(.Name)).Range("ad2:ad1000").Value = MyFile
would insert a null string.
 
Upvote 0
JLGWhiz said:
What does 'MyFile' equate to? Full name including file path? Only Workbook namd plus file extension? Only workbook name? What?
If MyFile has not been initialized with a value, this line
VBA Code: 
wb2.Sheets(LCase(.Name)).Range("ad2:ad1000").Value = MyFile
would insert a null string.
Click to expand...
i see. Myfile should be the name of wb2 that it is copying the sheet from. I also need the name of the sheet that was copied as well as the file name.
 
Upvote 0
Then somewhere above that line of code you need a statement like
VBA Code: 
MyFile = wb.Name
Tlhat would give you a result like "Book1.xlsx". So if you don't want the file extension then modify the statement like.
VBA Code: 
MyFile = Left(wb.Name, InStr(wb.Name, ".") - 1)
Which would yield "Book1"
To add the sheet name
VBA Code: 
MyFile = Left(wb.Name, InStr(wb.Name, ".") - 1) & "-" & Sheets(shArr(i)).Name

You might already have a place in the code where this could be done, but only a part of the procedure was posted so I can't offer any specific suggestion on where to put it. You also need to be sure your declarations (Dim statements) are correct for any variables used.
 
Upvote 0
JLGWhiz said:
Then somewhere above that line of code you need a statement like
VBA Code: 
MyFile = wb.Name
Tlhat would give you a result like "Book1.xlsx". So if you don't want the file extension then modify the statement like.
VBA Code: 
MyFile = Left(wb.Name, InStr(wb.Name, ".") - 1)
Which would yield "Book1"
To add the sheet name
VBA Code: 
MyFile = Left(wb.Name, InStr(wb.Name, ".") - 1) & "-" & Sheets(shArr(i)).Name

You might already have a place in the code where this could be done, but only a part of the procedure was posted so I can't offer any specific suggestion on where to put it. You also need to be sure your declarations (Dim statements) are correct for any variables used.
Click to expand...
VBA Code: 
Sub DRPimport2()

Dim MyFile As String, Filepath As String, data_wbk2 As String, data_wbk6 As String, myfile2 As String
Dim wb1 As Workbook, wb2 As Workbook, wb As Workbook
Dim erow As Long, i As Long
Dim fn As String, fn2 As String, fn3 As String
Dim shArr


Application.ScreenUpdating = False

shArr = Array("Details", "Detail", "Detail - DRP", "Detail - DRP Reversal")

data_wbk2 = InputBox("Enter month I.E. 08-MAY20", Default:="08-MAY20")
data_wbk6 = InputBox("Enter month Name I.E. YYYYMM:", Default:="202005")
fn = Left(data_wbk2, 6)
fn2 = Right(data_wbk2, 2)
fn3 = Right(data_wbk6, 2)
myfile2 = wb.Name

If Not SheetExists("DRP", ThisWorkbook) Then Worksheets.Add.Name = "DRP"

Filepath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\DRP\20" & fn2 & " DRP\20" & fn2 & "-" & fn3 & " Reporting Cycle\"
MyFile = Dir(Filepath & "*.xls*")
Do While Len(MyFile) > 0 And MyFile <> "suspense automation.xlsm"
    Set wb2 = Workbooks.Open(Filepath & MyFile)
    With wb2
        For i = LBound(shArr) To UBound(shArr)
        
            If SheetExists(CStr(shArr(i)), wb2) Then
                erow = ThisWorkbook.Sheets("DRP").Range("A" & Rows.Count).End(xlUp).Row + 1
                With .Sheets(shArr(i))
                    If .AutoFilterMode = True Then .AutoFilterMode = False
                     wb2.Sheets(LCase(.Name)).Range("ad2:ad1000").Value = myfile2
                     
                    If LCase(.Name) = "details" Then
                  
                      
         
         
         
    .Range("D2:AF1000").Copy Destination:=ThisWorkbook.Worksheets("DRP").Cells(erow, 1)
            
Else
       
    .Range("C2:AF1000").Copy Destination:=ThisWorkbook.Worksheets("DRP").Cells(erow, 1)
    
End If
                    End With
                
            End If
        Next
        .Close savechanges:=False
    End With
    MyFile = Dir
Loop

Application.ScreenUpdating = True

End Sub

Ok So I have posted the entire code. it keeps erroring out on myfile2. I have two different myfiles that I use. Can you please help?

Jordan
 
Upvote 0
You didn't need that variable for a single use when it is using another variable to initialize. Just use the wb2 variable to get the name. See if this code runs OK.

VBA Code: 
Sub DRPimport2()
Dim MyFile As String, Filepath As String, data_wbk2 As String, data_wbk6 As String
Dim wb1 As Workbook, wb2 As Workbook, wb As Workbook
Dim erow As Long, i As Long
Dim fn As String, fn2 As String, fn3 As String
Dim shArr
Application.ScreenUpdating = False
shArr = Array("Details", "Detail", "Detail - DRP", "Detail - DRP Reversal")
data_wbk2 = InputBox("Enter month I.E. 08-MAY20", Default:="08-MAY20")
data_wbk6 = InputBox("Enter month Name I.E. YYYYMM:", Default:="202005")
fn = Left(data_wbk2, 6)
fn2 = Right(data_wbk2, 2)
fn3 = Right(data_wbk6, 2)
If Not SheetExists("DRP", ThisWorkbook) Then Worksheets.Add.Name = "DRP"
Filepath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\DRP\20" & fn2 & " DRP\20" & fn2 & "-" & fn3 & " Reporting Cycle\"
MyFile = Dir(Filepath & "*.xls*")
Do While Len(MyFile) > 0 And MyFile <> "suspense automation.xlsm"
    Set wb2 = Workbooks.Open(Filepath & MyFile)
    With wb2
        For i = LBound(shArr) To UBound(shArr)        
            If SheetExists(CStr(shArr(i)), wb2) Then
                erow = ThisWorkbook.Sheets("DRP").Range("A" & Rows.Count).End(xlUp).Row + 1
                With .Sheets(shArr(i))
                    If .AutoFilterMode = True Then .AutoFilterMode = False
                    wb2.Sheets(LCase(.Name)).Range("ad2:ad1000") = wb2.Name                     
                    If LCase(.Name) = "details" Then
                        .Range("D2:AF1000").Copy Destination:=ThisWorkbook.Worksheets("DRP").Cells(erow, 1)            
                    Else       
                        .Range("C2:AF1000").Copy Destination:=ThisWorkbook.Worksheets("DRP").Cells(erow, 1)    
                    End If
                End With                
            End If
        Next
        .Close savechanges:=False
    End With
    MyFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
 
Upvote 0
JLGWhiz said:
You didn't need that variable for a single use when it is using another variable to initialize. Just use the wb2 variable to get the name. See if this code runs OK.

VBA Code: 
Sub DRPimport2()
Dim MyFile As String, Filepath As String, data_wbk2 As String, data_wbk6 As String
Dim wb1 As Workbook, wb2 As Workbook, wb As Workbook
Dim erow As Long, i As Long
Dim fn As String, fn2 As String, fn3 As String
Dim shArr
Application.ScreenUpdating = False
shArr = Array("Details", "Detail", "Detail - DRP", "Detail - DRP Reversal")
data_wbk2 = InputBox("Enter month I.E. 08-MAY20", Default:="08-MAY20")
data_wbk6 = InputBox("Enter month Name I.E. YYYYMM:", Default:="202005")
fn = Left(data_wbk2, 6)
fn2 = Right(data_wbk2, 2)
fn3 = Right(data_wbk6, 2)
If Not SheetExists("DRP", ThisWorkbook) Then Worksheets.Add.Name = "DRP"
Filepath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\DRP\20" & fn2 & " DRP\20" & fn2 & "-" & fn3 & " Reporting Cycle\"
MyFile = Dir(Filepath & "*.xls*")
Do While Len(MyFile) > 0 And MyFile <> "suspense automation.xlsm"
    Set wb2 = Workbooks.Open(Filepath & MyFile)
    With wb2
        For i = LBound(shArr) To UBound(shArr)       
            If SheetExists(CStr(shArr(i)), wb2) Then
                erow = ThisWorkbook.Sheets("DRP").Range("A" & Rows.Count).End(xlUp).Row + 1
                With .Sheets(shArr(i))
                    If .AutoFilterMode = True Then .AutoFilterMode = False
                    wb2.Sheets(LCase(.Name)).Range("ad2:ad1000") = wb2.Name                    
                    If LCase(.Name) = "details" Then
                        .Range("D2:AF1000").Copy Destination:=ThisWorkbook.Worksheets("DRP").Cells(erow, 1)           
                    Else      
                        .Range("C2:AF1000").Copy Destination:=ThisWorkbook.Worksheets("DRP").Cells(erow, 1)   
                    End If
                End With               
            End If
        Next
        .Close savechanges:=False
    End With
    MyFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
Click to expand...
thanks bud. This still doesnt insert the filename nor the sheet name the import works fine but just doesnt have the file name is column ad. It calls this function as well.


Function SheetExists(sSheet As String, wb As Workbook) As Boolean
Dim sh As Worksheet
For Each sh In wb.Worksheets
If LCase(CStr(sh.Name)) = LCase(sSheet) Then
SheetExists = True
Exit Function
End If
Next
SheetExists = False

End Function
 
Upvote 0
I made some more minor changes to the code. Hopefully, it will run without error, but if it does not just post back and we can fix it.

Your function title line needs to be modified as shown below:
Excel Formula: 
Function SheetExists(sSheet As String, ByVal wb As Workbook) As Boolean

Here is the code:
VBA Code: 
Sub DRPimport2()
Dim MyFile As String, Filepath As String, data_wbk2 As String, data_wbk6 As String
Dim wb1 As Workbook, wb2 As Workbook, wb As Workbook
Dim erow As Long, i As Long
Dim fn As String, fn2 As String, fn3 As String
Dim shArr
Application.ScreenUpdating = False
shArr = Array("details", "detail", "detail - DRP", "detail - DRP Reversal")
data_wbk2 = InputBox("Enter month I.E. 08-MAY20", Default:="08-MAY20")
data_wbk6 = InputBox("Enter month Name I.E. YYYYMM:", Default:="202005")
fn = Left(data_wbk2, 6)
fn2 = Right(data_wbk2, 2)
fn3 = Right(data_wbk6, 2)
If Not SheetExists("DRP", ThisWorkbook) Then Worksheets.Add.Name = "DRP"
Filepath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\DRP\20" & fn2 & " DRP\20" & fn2 & "-" & fn3 & " Reporting Cycle\"
MyFile = Dir(Filepath & "*.xls*")
Do While Len(MyFile) > 0
    If MyFile <> "suspense automation.xlsm" Then
        Set wb2 = Workbooks.Open(Filepath & MyFile)
        With wb2
            For i = LBound(shArr) To UBound(shArr)
                If SheetExists(CStr(shArr(i)), wb2) Then
                    erow = ThisWorkbook.Sheets("DRP").Range("A" & Rows.Count).End(xlUp).Row + 1
                    With .Sheets(shArr(i))
                        If .AutoFilterMode = True Then .AutoFilterMode = False
                        .Sheets(shArr(i)).Range("ad2:ad1000") = wb2.Name
                        If LCase(shArr(i)) = "details" Then
                            .Range("D2:AF1000").Copy Destination:=ThisWorkbook.Worksheets("DRP").Cells(erow, 1)
                        Else
                            .Range("C2:AF1000").Copy Destination:=ThisWorkbook.Worksheets("DRP").Cells(erow, 1)
                        End If
                    End With
                End If
            Next
            .Close savechanges:=False
        End With
    End If
    MyFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
modifying code to get last value based on sheet name from file to another
Replies
7
Views
180
mumps
mumps
R
  • Solved
SaveAs method not actually saving, wrong sheets being deleted (1004 Error)
Replies
4
Views
392
Alex Blakenburg
A
S
  • Question
VBA macro if criteria is met copy cells to another worksheet
Replies
8
Views
548
slohman
S
B
  • Question
Subscript Out of Range - Update Sheet Name (VBA)
2
Replies
10
Views
663
kevin9999
K
Y
  • Solved
Highlighting selected words in a column.
Replies
6
Views
127
Akuini
Akuini

Forum statistics

Threads
1,214,522
Messages
6,120,022
Members
448,939
Latest member
Leon Leenders

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top