insert filename and sheet name with code

jordanburch

Active Member
Joined
Jun 10, 2016
Messages
309
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

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
You need to be specific about what the problem is. I suspect you are trying to equate apples to oranges.
 

jordanburch

Active Member
Joined
Jun 10, 2016
Messages
309
Office Version
  1. 2016
You need to be specific about what the problem is. I suspect you are trying to equate apples to oranges.
its not inserting the filename in the column. Even though it has that code its not doing anything.
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
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.
 

jordanburch

Active Member
Joined
Jun 10, 2016
Messages
309
Office Version
  1. 2016

ADVERTISEMENT

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.
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.
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
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.
 

jordanburch

Active Member
Joined
Jun 10, 2016
Messages
309
Office Version
  1. 2016

ADVERTISEMENT

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.
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
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
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
 

jordanburch

Active Member
Joined
Jun 10, 2016
Messages
309
Office Version
  1. 2016
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
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
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,129,803
Messages
5,638,441
Members
417,025
Latest member
MusterDuster

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
Top