Help debugging data input code.

[Fiske]

Hi all!
I am still new to vba and doing a data input code where the user will be prompt to enter 4 different values on the first row. Once it reach the 4th column, the user will be prompt whether he/she wants to continue. If the user continues, the new values will be input into the 2nd row and also until the 4th column. At each row, the input values for second row will be hyperlink whereas the user will be prompt to select the file directory and it will then hyperlink the second column values to the directory selected.

Below is the code.

Private Sub CommandButton1_Click()

Dim Name, desp, iname, prtno, fldr As String
Dim i As Integer
Dim fnsh As Long


1:
  Name = InputBox("Company name?")
  If Name <> "" Then
  If IsEmpty(Cells(1, 1)) Then
  Cells(1, 1).Value = Name
  Else
  Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Name
  End If
  End If


  prtno = Application.InputBox("Please Enter File Extension", "Info Request")
  If prtno = False And Not TypeName(y) = "String" Then Exit Sub
  Application.ScreenUpdating = False
  With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        fldr = .SelectedItems(1)
    End With

    With Application.FileSearch
        .NewSearch
        .LookIn = fldr
        .SearchSubFolders = True
        .Filename = prtno
    
  If prtno <> "" Then
  If IsEmpty(Cells(1, 2)) Then
  Cells(1, 2).Value = prtno
  Else
  ActiveSheet.Hyperlinks.Add anchor:=Cells(Rows.Count, 2).End(xlUp).Offset(1, 0), Address:=fldr, TextToDisplay:=prtno
  Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = prtno
  End If
  End If
  End With
  
  desp = InputBox("Part Description?")
  If desp <> "" Then
  If IsEmpty(Cells(1, 3)) Then
  Cells(1, 3).Value = desp
  Else
  Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Value = desp
  End If
  End If


  iname = InputBox("Name?")
  If iname <> "" Then
  If IsEmpty(Cells(1, 4)) Then
  Cells(1, 4).Value = iname
  Else
  Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Value = iname
  End If
  End If
  
  i = MsgBox("Continue?", vbYesNo)
  If i = vbYes Then GoTo 1 Else GoTo 2
2:
  MsgBox ("End")
  

End Sub

The current results for this code is as shown below after 2 different inputs.

A1	B1	C1	D1
A2	B2	C2	D2
	B2

<tbody>
</tbody>

Errors:
-B1 is hyperlink however when a new value is insert, B1 will show that it is hyperlink however it is not.
-B2 is hyperlink however it input another unhyperlink of the same values at row 3.

I need help debugging my code so that B1 will be hyperlink to its file directory and so is B2 without entering another B2 on row 3 every time a new value is input.
Thank you!

PS. I am using excel 2003.

 

[Fiske]

Hi all i tried removing

[COLOR=#333333]Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = prtno[/COLOR]

Now the code works fine however the first row remains un-hyperlink even though it showed that it is hyperlink.
Need help as this is part of my work project :l
thanks!

 

[dmt32]

hi,
not fully tested & may need further work but see if this change to your code helps:

Sub CommandButton1_Click()


    Dim fldr As String
    Dim i As Integer
    Dim Promptarr As Variant, GetInput(4) As Variant
    Dim folder As FileDialog


    Promptarr = Array("Company Name", "Enter File Extension", "Part Description", "Name")


    Do
        i = 0
        Do
            GetInput(i) = InputBox(Promptarr(i), Promptarr(i))
            If StrPtr(GetInput(i)) = 0 Then Exit Sub
            If Len(GetInput(i)) > 0 Then i = i + 1
        Loop Until i > 3




        Set folder = Application.FileDialog(msoFileDialogFolderPicker)


        With folder
            .Title = "Please Select a Folder"
            ' .InitialFileName = "C:\"
            .AllowMultiSelect = False


            If .Show <> -1 Then Exit Sub
            fldr = .SelectedItems(1)
        End With


        With Sheets("Sheet1")
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            If Not IsEmpty(.Cells(1, 1)) Then lastrow = lastrow + 1
            .Cells(lastrow, 1).Resize(1, UBound(GetInput)).Value = GetInput
            .Hyperlinks.Add anchor:=.Cells(lastrow, 2), Address:=fldr, TextToDisplay:=GetInput(1)
        End With
        
    Set folder = Nothing
    fldr = ""
    Loop Until MsgBox("Do You Want To Continue?", 36, "Continue") = vbNo


End Sub

Change the sheet name shown in RED as required.

Dave

 

[Fiske]

hi,
not fully tested & may need further work but see if this change to your code helps:

Sub CommandButton1_Click()


    Dim fldr As String
    Dim i As Integer
    Dim Promptarr As Variant, GetInput(4) As Variant
    Dim folder As FileDialog


    Promptarr = Array("Company Name", "Enter File Extension", "Part Description", "Name")


    Do
        i = 0
        Do
            GetInput(i) = InputBox(Promptarr(i), Promptarr(i))
            If StrPtr(GetInput(i)) = 0 Then Exit Sub
            If Len(GetInput(i)) > 0 Then i = i + 1
        Loop Until i > 3




        Set folder = Application.FileDialog(msoFileDialogFolderPicker)


        With folder
            .Title = "Please Select a Folder"
            ' .InitialFileName = "C:\"
            .AllowMultiSelect = False


            If .Show <> -1 Then Exit Sub
            fldr = .SelectedItems(1)
        End With


        With Sheets("Sheet1")
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            If Not IsEmpty(.Cells(1, 1)) Then lastrow = lastrow + 1
            .Cells(lastrow, 1).Resize(1, UBound(GetInput)).Value = GetInput
            .Hyperlinks.Add anchor:=.Cells(lastrow, 2), Address:=fldr, TextToDisplay:=GetInput(1)
        End With
        
    Set folder = Nothing
    fldr = ""
    Loop Until MsgBox("Do You Want To Continue?", 36, "Continue") = vbNo


End Sub

Change the sheet name shown in RED as required.

Dave

Hi Dave!
The code works great! However is it possible that after the user the file name (second prompt), it is prompt to select the folder rather than after the 4th input then select the folder.
To reduce the confusion for the user.
Thanks for helping me out btw! Much appreciated!

 

[dmt32]

Hi Dave!
The code works great! However is it possible that after the user the file name (second prompt), it is prompt to select the folder rather than after the 4th input then select the folder.
To reduce the confusion for the user.
Thanks for helping me out btw! Much appreciated!

Hi give this a try & see if does what you want:

Sub CommandButton1_Click()


    Dim fldr As Variant
    Dim i As Integer
    Dim Promptarr As Variant, GetInput(4) As Variant
    Dim Folder As FileDialog


    Promptarr = Array("Company Name", "Enter File Extension", "Part Description", "Name")


    Do
        i = 0
        Do
            GetInput(i) = InputBox(Promptarr(i), Promptarr(i))
            If StrPtr(GetInput(i)) = 0 Then Exit Sub
            If Len(GetInput(i)) > 0 Then i = i + 1
            If i = 1 Then fldr = GetFolder: If IsError(fldr) Then Exit Sub
        Loop Until i > 3




        With Sheets("Sheet2")
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            If Not IsEmpty(.Cells(1, 1)) Then lastrow = lastrow + 1
            .Cells(lastrow, 1).Resize(1, UBound(GetInput)).Value = GetInput
            .Hyperlinks.Add anchor:=.Cells(lastrow, 2), Address:=fldr, TextToDisplay:=GetInput(1)
        End With
        
    Set Folder = Nothing
    fldr = ""
    Loop Until MsgBox("Do You Want To Continue?", 36, "Continue") = vbNo


End Sub


Function GetFolder(Optional ByVal FolderPath As String) As Variant
    Dim Folder As FileDialog
    Dim Selecteditem As Variant
    Set Folder = Application.FileDialog(msoFileDialogFolderPicker)
    With Folder
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = FolderPath
        If .Show <> -1 Then
            Selecteditem = CVErr(10)
        Else
            Selecteditem = .SelectedItems(1)
        End If
    End With


    GetFolder = Selecteditem
    Set Folder = Nothing
End Function

I have move the msoFileDialogFolderPicker to a separate function GetFolder which has an optional argument FolderPath if you want to specify an Initial FileName.
To do so, you would call function like this:

fldr = GetFolder(FolderPath:="C:\")

Hope Helpful

Dave

 

[Fiske]

Hi dave,
it works great thanks! ^^