Help - create a button to ask the user to input the name of the sheet

[jimmygogo]

Hi there, I am creating a VBA code which copies data to my sheet from various workbooks stored in another folder. The excel files in the workbook have many sheet. I need to create a button where user is asked to input the name of the sheet where the code copies data from ? Currently, I have setup like this. Instead of having the sheet name in the code, I want user to input it.

Do While myFile <> ""
Workbooks.Open Filename:=(myfolder & myFile), UpdateLinks:=0
a = ActiveWorkbook.Sheets("09-01-2022").Range("B13").Text
x = ActiveWorkbook.Sheets("09-01-2022").Range("N13").Value
y = ActiveWorkbook.Sheets("09-01-2022").Range("N14").Value

Thank you a lot in advance

 

[mumps]

Try:

Dim sh As String
sh = InputBox("Enter the name of the sheet.")
If sh = "" Then Exit Sub
Do While myFile <> ""
    Workbooks.Open Filename:=(myfolder & myFile), UpdateLinks:=0
    With ActiveWorkbook.Sheets(sh)
        a = .Range("B13").Text
        x = .Range("N13").Value
        y = .Range("N14").Value
    End With
Loop

 

[jimmygogo]

Try:

Dim sh As String
sh = InputBox("Enter the name of the sheet.")
If sh = "" Then Exit Sub
Do While myFile <> ""
    Workbooks.Open Filename:=(myfolder & myFile), UpdateLinks:=0
    With ActiveWorkbook.Sheets(sh)
        a = .Range("B13").Text
        x = .Range("N13").Value
        y = .Range("N14").Value
    End With
Loop

Thank you! works perfect - Can I ask you a favor ? Can you help me make my code better as I am very new at it. Its working now but I feel it can be cleaned up.

Basically, my sheets looks at the employees timesheet in a folder and gets total time spent (Column N) on each project (column B). As I am using absolute reference, its showing me projects with zero hours.

Do While myFile <> ""
Workbooks.Open Filename:=(myfolder & myFile), UpdateLinks:=0
With ActiveWorkbook.sheets(sh)
a = .Range("B13").Text
x = .Range("N13").Value
b = .Range("B14").Text
y = .Range("N14").Value
c = .Range("B15").Text
d = .Range("N15").Value
e = .Range("B16").Text
f = .Range("N16").Value
g = .Range("B17").Text
h = .Range("N17").Value
k = .Range("B18").Text
l = .Range("N18").Value
m = .Range("B19").Text
n = .Range("N19").Value
z = myFile
End With

ActiveWorkbook.Close SaveChanges:=False

Windows("cook.xltm").Activate
ActiveWorkbook.sheets("cook").Cells(i, 2).Value = a
ActiveWorkbook.sheets("cook").Cells(i, 3).Value = x
ActiveWorkbook.sheets("cook").Cells(i, 4).Value = b
ActiveWorkbook.sheets("cook").Cells(i, 5).Value = y
ActiveWorkbook.sheets("cook").Cells(i, 6).Value = c
ActiveWorkbook.sheets("cook").Cells(i, 7).Value = d
ActiveWorkbook.sheets("cook").Cells(i, 8).Value = e
ActiveWorkbook.sheets("cook").Cells(i, 9).Value = f
ActiveWorkbook.sheets("cook").Cells(i, 10).Value = g
ActiveWorkbook.sheets("cook").Cells(i, 11).Value = h
ActiveWorkbook.sheets("cook").Cells(i, 12).Value = k
ActiveWorkbook.sheets("cook").Cells(i, 13).Value = l
ActiveWorkbook.sheets("cook").Cells(i, 14).Value = m
ActiveWorkbook.sheets("cook").Cells(i, 15).Value = n
ActiveWorkbook.sheets("cook").Cells(i, 18) = z


myFile = Dir
i = i + 1

Loop

Result I am getting -

 

[johnnyL]

@jimmygogo The following is a shorter, hopefully less confusing version of the code you posted:

    Dim ArrayRow                As Long, RowCount           As Long
    Dim Column_B_Array          As Variant, Column_N_Array  As Variant
    Dim OutputArray(1 To 14)    As Variant
'
'-------------------------------------------------------------------
'
    Do While myFile <> ""
        Workbooks.Open Filename:=(myfolder & myFile), UpdateLinks:=0
'
        With ActiveWorkbook.Sheets(sh)
' Load Column_B_Array
            Column_B_Array = Range("B13:B19")
' Load Column_N_Array
            Column_N_Array = Range("N13:N19")
'
            Z = myFile
        End With
'
        ActiveWorkbook.Close SaveChanges:=False
'
'-------------------------------------------------------------------
'
' Create OutputArray
        RowCount = -1
'
        For ArrayRow = 1 To 7
            RowCount = RowCount + 2
'
                OutputArray(RowCount) = Column_B_Array(ArrayRow, 1)
            OutputArray(RowCount + 1) = Column_N_Array(ArrayRow, 1)
        Next
'
'-------------------------------------------------------------------
'
        Windows("cook.xltm").Activate
'
' Display OutputArray
        ActiveWorkbook.Sheets("cook").Cells(i, 2).Resize(1, UBound(OutputArray)) = OutputArray
'
        ActiveWorkbook.Sheets("cook").Cells(i, 18) = Z
'
        myFile = Dir
'
        i = i + 1
    Loop

Let us know where you are at after trying that in place of the code you submitted.

 

[mumps]

Try:

Sub test()
    Dim srcWB As Workbook, srcWS As Worksheet
    Do While myFile <> ""
        Set srcWB = Workbooks.Open(myfolder & myFile, UpdateLinks:=0)
        Set srcWS = Sheets(sh)
        With Workbooks("cook.xlsm").Sheets("cook")
            .Cells(.Rows.Count, "B").End(xlUp).Offset(1).Resize(, 14).Value = Array(srcWS.Range("B13"), srcWS.Range("N13"), srcWS.Range("B14"), _
                srcWS.Range("N14"), srcWS.Range("B15"), srcWS.Range("N15"), srcWS.Range("B16"), srcWS.Range("B16"), srcWS.Range("B17"), _
                srcWS.Range("N17"), srcWS.Range("B18"), srcWS.Range("N18"), srcWS.Range("B19"), srcWS.Range("N19"))
            .Cells(.Rows.Count, "R").End(xlUp).Offset(1) = myFile
        End With
        srcWB.Close False
        myFile = Dir
    Loop
End Sub

 

[jimmygogo]

@jimmygogo The following is a shorter, hopefully less confusing version of the code you posted:

    Dim ArrayRow                As Long, RowCount           As Long
    Dim Column_B_Array          As Variant, Column_N_Array  As Variant
    Dim OutputArray(1 To 14)    As Variant
'
'-------------------------------------------------------------------
'
    Do While myFile <> ""
        Workbooks.Open Filename:=(myfolder & myFile), UpdateLinks:=0
'
        With ActiveWorkbook.Sheets(sh)
' Load Column_B_Array
            Column_B_Array = Range("B13:B19")
' Load Column_N_Array
            Column_N_Array = Range("N13:N19")
'
            Z = myFile
        End With
'
        ActiveWorkbook.Close SaveChanges:=False
'
'-------------------------------------------------------------------
'
' Create OutputArray
        RowCount = -1
'
        For ArrayRow = 1 To 7
            RowCount = RowCount + 2
'
                OutputArray(RowCount) = Column_B_Array(ArrayRow, 1)
            OutputArray(RowCount + 1) = Column_N_Array(ArrayRow, 1)
        Next
'
'-------------------------------------------------------------------
'
        Windows("cook.xltm").Activate
'
' Display OutputArray
        ActiveWorkbook.Sheets("cook").Cells(i, 2).Resize(1, UBound(OutputArray)) = OutputArray
'
        ActiveWorkbook.Sheets("cook").Cells(i, 18) = Z
'
        myFile = Dir
'
        i = i + 1
    Loop

Let us know where you are at after trying that in place of the code you submitted.

I tried but I am getting the following error

 

[jimmygogo]

Try:

Sub test()
    Dim srcWB As Workbook, srcWS As Worksheet
    Do While myFile <> ""
        Set srcWB = Workbooks.Open(myfolder & myFile, UpdateLinks:=0)
        Set srcWS = Sheets(sh)
        With Workbooks("cook.xlsm").Sheets("cook")
            .Cells(.Rows.Count, "B").End(xlUp).Offset(1).Resize(, 14).Value = Array(srcWS.Range("B13"), srcWS.Range("N13"), srcWS.Range("B14"), _
                srcWS.Range("N14"), srcWS.Range("B15"), srcWS.Range("N15"), srcWS.Range("B16"), srcWS.Range("B16"), srcWS.Range("B17"), _
                srcWS.Range("N17"), srcWS.Range("B18"), srcWS.Range("N18"), srcWS.Range("B19"), srcWS.Range("N19"))
            .Cells(.Rows.Count, "R").End(xlUp).Offset(1) = myFile
        End With
        srcWB.Close False
        myFile = Dir
    Loop
End Sub

Thanks for sending this. I did try this but I am getting this error

 

[jimmygogo]

Can this code be programmed to only select text (project number) in column B if there is value in column N (amount of hours) ?

 

[johnnyL]

@jimmygogo you didn't mention which line number those errors are occurring on.

 

[jimmygogo]

@jimmygogo you didn't mention which line number those errors are occurring on.

Sorry, its occurs in the display output

'
' Display OutputArray
ActiveWorkbook.sheets("cook").Cells(i, 2).Resize(1, UBound(OutputArray)) = OutputArray