insert filename and sheet name with code

[jordanburch]

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]

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:

Function SheetExists(sSheet As String, ByVal wb As Workbook) As Boolean

Here is the 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

 

[jordanburch]

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:

Function SheetExists(sSheet As String, ByVal wb As Workbook) As Boolean

Here is the 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]

What are the error messages?

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

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

 

[jordanburch]

What are the error messages?

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]

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

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]

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

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]

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]

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.