Change code to an input box to enter the file name

Hi all,

I have some code which i have tested and is working great, but i would like to change it slightly so that i can input a file name so it picks the correct .xls workbook.

in my code at the minute it is looking for "sample_BOM" i would like to be able to enter the file name manual every time, i have commented the code so you can see where it is.

Private Sub OptionButton1_Change()
If Me.OptionButton1.Value = True Then
Me.ComboBox1.List = Array("POWER", "CONTROL")
ElseIf Me.OptionButton2.Value = True Then
Me.ComboBox1.List = Array("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", "38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "CS")
End If
End Sub
Private Sub UserForm_Initialize2()
    Dim ListArray As Variant
        With Sheets("Sheet1")
        ListArray = .Range(.Range("a1"), .Range("a" & Rows.Count).End(xlUp))
        End With
        ListBox1.List = ListArray
End Sub
Private Sub UserForm_Initialize()
    Dim lb As MSForms.ListBox
    Dim rcArray() As Variant
    Dim lrw As Long, lcol As Long
    Dim rSource As Range
    Set rSource = Workbooks("Sample_BOM.xls").Worksheets("Sheet1").Range("A7:D100") 'THIS IS THE LINE OF CODE I WOULD LIKE TO CHANGE.
    ReDim Preserve rcArray(1 To rSource.Rows.Count, 1 To rSource.Columns.Count)
    With rSource
        For lcol = 1 To .Columns.Count
            For lrw = 1 To .Rows.Count
                rcArray(lrw, lcol) = rSource.Cells(lrw, lcol)
            Next lrw
        Next lcol
    End With
    For Each cell In rSource
        If cell.Value <> vbNullString Then
            Set lb = Me.ListBox1
                With lb
                    .ColumnCount = 4
                    .ColumnWidths = "50,150,100;50"
                    .List = rcArray
                End With
        End If
    Next cell
End Sub
Private Sub CommandButton2_Click()
Dim wks As Worksheet
Dim nextAvailableRow As Long
Dim i As Long

Set wks = Sheets(ComboBox1.Value)
Sheets(ComboBox1.Value).Activate
    For i = 0 To ListBox1.ListCount - 1
        nextAvailableRow = wks.Range("C" & Rows.Count).End(xlUp).Row + 1
        wks.Range("A" & nextAvailableRow) = ListBox1.Column(0, i)
        wks.Range("B" & nextAvailableRow) = ListBox1.Column(1, i)
        wks.Range("C" & nextAvailableRow) = ListBox1.Column(2, i)
        wks.Range("D" & nextAvailableRow) = ListBox1.Column(3, i)
    Next i
    
End Sub

I would also like to only open the userform when a button is pressed in the excel worksheet and not automatically when the workbook is opened. I have this macro attached to a button which opens the user form once the BOM is open.

Sub Auto_Open()
    Dim ws As Worksheet
    For Each ws In Worksheets
        UserForm1.ComboBox1.AddItem ws.Name
    Next ws
    UserForm1.Show
End Sub

Thank you both of you!!

this has worked perfectly!

Would it be possible to add an error message to the code so if the file is not open it tells you rather than creating an error to debug?

"Bill of Materials Not Open Please Open First"

I have two separate codes and i'm not sure which bit i would put the code in,

Private Sub OptionButton1_Change()
If Me.OptionButton1.Value = True Then
Me.ComboBox1.List = Array("POWER", "CONTROL")
ElseIf Me.OptionButton2.Value = True Then
Me.ComboBox1.List = Array("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", "38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "CS")
End If
End Sub
Private Sub UserForm_Initialize2()
    Dim ListArray As Variant
        With Sheets("Sheet1")
        ListArray = .Range(.Range("a1"), .Range("a" & Rows.Count).End(xlUp))
        End With
        ListBox1.List = ListArray
End Sub
Private Sub UserForm_Initialize()
    Dim lb As MSForms.ListBox
    Dim rcArray() As Variant
    Dim lrw As Long, lcol As Long
    Dim rSource As Range
    Dim wBook As String
    wBook = Application.InputBox("Enter filename and extension.", "FileName", , , , , , 2)
    Set rSource = Workbooks(wBook).Worksheets("Sheet1").Range("A7:D100")
    ReDim Preserve rcArray(1 To rSource.Rows.Count, 1 To rSource.Columns.Count)
    With rSource
        For lcol = 1 To .Columns.Count
            For lrw = 1 To .Rows.Count
                rcArray(lrw, lcol) = rSource.Cells(lrw, lcol)
            Next lrw
        Next lcol
    End With
    For Each cell In rSource
        If cell.Value <> vbNullString Then
            Set lb = Me.ListBox1
                With lb
                    .ColumnCount = 2
                    .ColumnWidths = "200,50"
                    .List = rcArray
                End With
        End If
    Next cell
End Sub
Private Sub CommandButton2_Click()
Dim wks As Worksheet
Dim nextAvailableRow As Long
Dim i As Long

Set wks = Sheets(ComboBox1.Value)
Sheets(ComboBox1.Value).Activate
    For i = 0 To ListBox1.ListCount - 1
        nextAvailableRow = wks.Range("A" & Rows.Count).End(xlUp).Row + 1
        wks.Range("A" & nextAvailableRow) = ListBox1.Column(0, i)
        wks.Range("B" & nextAvailableRow) = ListBox1.Column(1, i)

    Next i
    
End Sub

then the macro to open the user form.

Private Sub Button1_Click()

UserForm1.Show

End Sub

I still get an error on the macro, i'm not sure if i have put it in the correct place.

Private Sub OptionButton1_Change()
If Me.OptionButton1.Value = True Then
Me.ComboBox1.List = Array("POWER", "CONTROL")
ElseIf Me.OptionButton2.Value = True Then
Me.ComboBox1.List = Array("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", "38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "CS")
End If
End Sub
Private Sub UserForm_Initialize2()
    Dim ListArray As Variant
        With Sheets("Sheet1")
        ListArray = .Range(.Range("a1"), .Range("a" & Rows.Count).End(xlUp))
        End With
        ListBox1.List = ListArray
End Sub
Function BookOpen(wbName As String) As Boolean
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks(wbName)
BookOpen = Not (Err.Number > 0)
End Function
Sub tst()
If Not BookOpen("wBook") Then Workbooks.Open ThisWorkbook.Path & "\" & "Filename"
End Sub
Private Sub UserForm_Initialize()
    Dim lb As MSForms.ListBox
    Dim rcArray() As Variant
    Dim lrw As Long, lcol As Long
    Dim rSource As Range
    Dim wBook As String
    wBook = Application.InputBox("Enter filename and extension.", "FileName", , , , , , 2)
    Set rSource = Workbooks(wBook).Worksheets("Sheet1").Range("A7:D100")
    ReDim Preserve rcArray(1 To rSource.Rows.Count, 1 To rSource.Columns.Count)
    With rSource
        For lcol = 1 To .Columns.Count
            For lrw = 1 To .Rows.Count
                rcArray(lrw, lcol) = rSource.Cells(lrw, lcol)
            Next lrw
        Next lcol
    End With
    For Each cell In rSource
        If cell.Value <> vbNullString Then
            Set lb = Me.ListBox1
                With lb
                    .ColumnCount = 2
                    .ColumnWidths = "200,50"
                    .List = rcArray
                End With
        End If
    Next cell
End Sub
Private Sub CommandButton2_Click()
Dim wks As Worksheet
Dim nextAvailableRow As Long
Dim i As Long

Set wks = Sheets(ComboBox1.Value)
Sheets(ComboBox1.Value).Activate
    For i = 0 To ListBox1.ListCount - 1
        nextAvailableRow = wks.Range("A" & Rows.Count).End(xlUp).Row + 1
        wks.Range("A" & nextAvailableRow) = ListBox1.Column(0, i)
        wks.Range("B" & nextAvailableRow) = ListBox1.Column(1, i)

    Next i
    
End Sub

bakerman2,

Where should i put this code? Will it still work if my root folder is different every time?

This is what i tried in the macro, but again it came up with an error.

Function BookOpen(wbName As String) As Boolean
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks(wbName)
BookOpen = Not (Err.Number > 0)
End Function

Sub tst()
Const fRootPath As String = "\\NEWBENSON\Company\IMC Issue Sheets"
If Not BookOpen("wBook") Then Workbooks.Open ThisWorkbook.fRootPath & "\" & "wBook"
End Sub

Private Sub Button1_Click()
UserForm1.ShowEnd Sub

I have decide that the file location will be in the same place every time so no need to worry about that any more

Hi Bakerman2,

I have put the function in a new module, and then inserted the code above, but i get an error saying \\NEWBENSON\Company\IMC Issue Sheets\wBook can not be found, it doesnt seem to be searching for the .xls file.

any suggestions?

I have managed to work out how to get the .xls open and that now works perfectly!

I have one other little problem now which i was unaware off til just now, Would it be possible to add another input box to get the worksheet name?

Private Sub UserForm_Initialize()
    Dim lb As MSForms.ListBox
    Dim rcArray() As Variant
    Dim lrw As Long, lcol As Long
    Dim rSource As Range
    Dim wBook As String
    Dim wSheet As String
    
    Const fRootPath As String = "\\NEWBENSON\Company\IMC Issue Sheets"
    wBook = Application.InputBox("Enter filename and extension.", "wBook", , , , , , 2)
    wSheet = Application.InputBox("Enter Sheet Name.", "wSheet", , , , , , 2)
   If Not BookOpen(wBook) Then Workbooks.Open fRootPath & "\" & wBook & ".xls"
   
    Set rSource = Workbooks(wBook).Worksheets("wSheet").Range("A7:D100")
    ReDim Preserve rcArray(1 To rSource.Rows.Count, 1 To rSource.Columns.Count)
    With rSource
        For lcol = 1 To .Columns.Count
            For lrw = 1 To .Rows.Count
                rcArray(lrw, lcol) = rSource.Cells(lrw, lcol)
            Next lrw
        Next lcol
    End With
    For Each cell In rSource
        If cell.Value <> vbNullString Then
            Set lb = Me.ListBox1
                With lb
                    .ColumnCount = 2
                    .ColumnWidths = "200,50"
                    .List = rcArray
                End With
        End IF
    Next cell

I have just tried to create the code myself but doesnt work thing i have something wrong!

I'm not sure what that means, very new to vba code sorry!

I thought i was close! just tried it and it worked perfectly!

Thanks for your help through all this!

REP ADDED

Cheers
ND