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
 

jordanburch

Active Member
Joined
Jun 10, 2016
Messages
309
Office Version
  1. 2016
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
Thanks again! This gave the same error in a different line
.Sheets(shArr(i)).Range("ad2:ad1000") = wb2.Name

thats where its erroring out on. Seems like its having trouble selecting that sheet for some reason.

Jordan
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!

jordanburch

Active Member
Joined
Jun 10, 2016
Messages
309
Office Version
  1. 2016
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
Hi Whiz
any chance you can help me with this today? im trying to get it done by EOD and am struggling. it seems simple but I cant figure it out for the life of me. Thanks!

Jordan
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
What are the error messages?

Rich (BB code):
shArr = Array("Details", "Detail", "Detail - DRP", "Detail - DRP Reversal")

Be sure your sheet tab names are exactly like the names in the array.
 

jordanburch

Active Member
Joined
Jun 10, 2016
Messages
309
Office Version
  1. 2016
What are the error messages?

Rich (BB code):
shArr = Array("Details", "Detail", "Detail - DRP", "Detail - DRP Reversal")

Be sure your sheet tab names are exactly like the names in the array.
Yeah they look like the array above. It gives me runtime error 438 object does not support this property or method.

.Sheets(shArr(i)).Range("ad2:ad1000") = wb2.Name

thats the yellow line.
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

The .Sheets(shArr(i)) is not needed becasuse it is inside a with statement for that sheet. Change as shown below

VBA Code:
With .Sheets(shArr(i))
        If .AutoFilterMode = True Then .AutoFilterMode = False
        .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
 

jordanburch

Active Member
Joined
Jun 10, 2016
Messages
309
Office Version
  1. 2016
The .Sheets(shArr(i)) is not needed becasuse it is inside a with statement for that sheet. Change as shown below

VBA Code:
With .Sheets(shArr(i))
        If .AutoFilterMode = True Then .AutoFilterMode = False
        .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
thanks but for whatever reason its still not sowing up in column ad. I am wondering if its putting the sheet name in the first sheet of the file. These files have multiple sheets and not all have those names.
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
You can open the vb editor, left click in the macro body once then press and release the F8 function key. The title line of the macro should then be highlighted. Continue to step through the macro with each press of the F8 key. By resizing the editor screen and moving it around, you can see what the code is doing to the worksheet. You can also see what variable values are by hovering the mouse pointer over them to activate the intellisense display. I don''t think I can help much more because the code, as recently modified, works for me without error.

If you do not have a sheet in wb2 by the same name as the shArr(i) variable, it would not post the names.
 

jordanburch

Active Member
Joined
Jun 10, 2016
Messages
309
Office Version
  1. 2016
You can open the vb editor, left click in the macro body once then press and release the F8 function key. The title line of the macro should then be highlighted. Continue to step through the macro with each press of the F8 key. By resizing the editor screen and moving it around, you can see what the code is doing to the worksheet. You can also see what variable values are by hovering the mouse pointer over them to activate the intellisense display. I don''t think I can help much more because the code, as recently modified, works for me without error.

If you do not have a sheet in wb2 by the same name as the shArr(i) variable, it would not post the names.
I have tried that and It jjust loops through all the files and still does the same thing. I think I might try a totally different method. it doesnt give me errors either it just doesnt insert the file name.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,804
Messages
5,638,450
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