Next Row VBA issue - Beginner

dellehurley · Feb 21, 2020

Hello,
I am really hoping someone came help me. I have been trying to teach my self VBA using YouTube etc as my teacher. I have working on this Data Form, I am getting there but I having one issue. I have tried heaps of things and this is the closest I have come to it working.

I have set up a user form. My issue is the record in green should be one line and the record in yellow another. #Value should be replaced with the File name.

I have gone around in circle but this trying to make it work the code I have now is.....

Dim msgValue As VbMsgBoxResult
Dim sh4 As Worksheet
Dim sh2 As Worksheet
Dim iRow As Long
iRow = [Counta(Database!A:A)] ' identifying the last row

Set sh4 = ThisWorkbook.Sheets("File Name Sheet")
Set sh2 = ThisWorkbook.Sheets("Database")

With sh4

.Range("J12").Value = Me.cmbFileNo.Value

.Range("K12").Value = Me.cmbType.Value

.Range("L12").Value = Me.cmbEvent.Value

.Range("M12").Value = Me.cmbExt.Value

If FrmForm.txtRowNumber.Value = "" Then

iRow = [Counta(Database!A:A)] + 1
Else

iRow = FrmForm.txtRowNumber.Value

End If

With sh2

.Cells(iRow, 1) = sh4.Range("I12").Value

If msgValue = vbNo Then Exit Sub

Call Submit
Call Reset

End With
End With

(I realise the last "end with" shouldn't be there but it does not work at all without it.) Any advise is appreciated. Dannielle

dmt32 · Feb 21, 2020

Hi,

See if my attempt to update your code helps you

Rich (BB code):

Private Sub CommandButton1_Click()
    Dim msgValue As VbMsgBoxResult
    Dim sh4 As Worksheet
    Dim sh2 As Worksheet
    Dim iRow As Long
   
   
    Set sh4 = ThisWorkbook.Sheets("File Name Sheet")
    Set sh2 = ThisWorkbook.Sheets("Database")
   
'File Name Sheet
    With sh4
        .Range("J12").Value = Me.cmbFileNo.Value
        .Range("K12").Value = Me.cmbType.Value
        .Range("L12").Value = Me.cmbEvent.Value
        .Range("M12").Value = Me.cmbExt.Value
    End With
   

    If Val(Me.txtRowNumber.Value) = 0 Then
   
'Get Next Row

        iRow = [Counta(Database!A:A)] + 1
       
'OR use common method to find lastrow in worksheet range
       ' iRow = sh2.Cells(sh2.Rows.Count, "A").End(xlUp).Row + 1
    Else
       
        iRow = Val(Me.txtRowNumber.Value)
       
    End If
   
'Database Sheet
    With sh2
       
        .Cells(iRow, 1) = sh4.Range("I12").Value
       
    End With
   
'Ask user for response
    msgValue = MsgBox("Do Something Else?", 36, "Do Something")
    If msgValue = vbNo Then Exit Sub
   
    Call Submit
    Call Reset
   
End Sub

I have included line shown in bold which is a common method used to find last row in a worksheet range
Also, I note to a fixed range in your File Name Sheet - not sure if this is what you really intend?

If still having issues then publish all your forms code together with your worksheet would be helpful to forum - Plenty here to offer help

Dave

dellehurley · Feb 21, 2020

dmt32 said:

Hi,

See if my attempt to update your code helps you

Rich (BB code):

Private Sub CommandButton1_Click()
    Dim msgValue As VbMsgBoxResult
    Dim sh4 As Worksheet
    Dim sh2 As Worksheet
    Dim iRow As Long
  
  
    Set sh4 = ThisWorkbook.Sheets("File Name Sheet")
    Set sh2 = ThisWorkbook.Sheets("Database")
  
'File Name Sheet
    With sh4
        .Range("J12").Value = Me.cmbFileNo.Value
        .Range("K12").Value = Me.cmbType.Value
        .Range("L12").Value = Me.cmbEvent.Value
        .Range("M12").Value = Me.cmbExt.Value
    End With
  

    If Val(Me.txtRowNumber.Value) = 0 Then
  
'Get Next Row

        iRow = [Counta(Database!A:A)] + 1
      
'OR use common method to find lastrow in worksheet range
       ' iRow = sh2.Cells(sh2.Rows.Count, "A").End(xlUp).Row + 1
    Else
      
        iRow = Val(Me.txtRowNumber.Value)
      
    End If
  
'Database Sheet
    With sh2
      
        .Cells(iRow, 1) = sh4.Range("I12").Value
      
    End With
  
'Ask user for response
    msgValue = MsgBox("Do Something Else?", 36, "Do Something")
    If msgValue = vbNo Then Exit Sub
  
    Call Submit
    Call Reset
  
End Sub

I have included line shown in bold which is a common method used to find last row in a worksheet range
Also, I note to a fixed range in your File Name Sheet - not sure if this is what you really intend?

If still having issues then publish all your forms code together with your worksheet would be helpful to forum - Plenty here to offer help

Dave

Hi Dave
Thanks for your reply. Unfortunately the same thing is happening.

Originally I wanted a formula (=((LEFT(K12,1))&(LEFT(L12,2))&(TEXT(J12,"0000"))&("."&M12)) in Column A in row. I could not figure that out for more than the first row, so...
I added a worksheet. Sent the information form the user form to the worksheet, used the formula and then tried to send that information back to the cell in column A.
Convoluted but the best I have managed but I am happy to remove these extra steps.

I have attached everything this time (I hope you meant this literally

) but before I do I will point out that there is a bug with the delete code.
It was working but obviously one of my changes has mucked it up, it is next on my to do list.

VBA Code:

 [COLOR=rgb(85, 57, 130)][SIZE=3]iRow = Application.WorksheetFunction.Match(Me.lstDatabase.List(Me.lstDatabase.ListIndex, 0), _
    ThisWorkbook.Sheets("Database").Range("A:A"), 0)

[/SIZE][/COLOR]

Here goes

Thanks again in advance for your help.
Dannielle

MODULE 1 VBA

VBA Code:

Sub Reset()

    Dim iRow As Long
    iRow = [Counta(Database!A:A)] ' identifying the last row
    
    With FrmForm

        .cmbFileNo.Value = Clear
        
        'Creating Dynamic Name for FileNo.
        
        shUnused.Range("E2", shUnused.Range("E" & Application.Rows.Count).End(xlUp)).Name = "UnusedNo"
        
        .cmbFileNo.RowSource = "UnusedNo"
            
        
        .cmbType.Value = Clear
        
        .cmbType.AddItem "File"
        .cmbType.AddItem "Picture"
        .cmbType.AddItem "Website"
        
              
        .cmbEvent.Value = Clear
        
        .cmbEvent.AddItem "Birth"
        .cmbEvent.AddItem "Burial"
        .cmbEvent.AddItem "Christening"
        .cmbEvent.AddItem "Death"
        .cmbEvent.AddItem "Individual"
        .cmbEvent.AddItem "Marriage"
        .cmbEvent.AddItem "Residence"
        
        
        .cmbExt.Value = Clear
        
        .cmbExt.AddItem "pdf"
        .cmbExt.AddItem "jpg"
        
        
        .cmbFullName.Value = Clear
        
        'Creating Dynamic Name for Full Name
        
        shNameWks.Range("A2", shNameWks.Range("A" & Application.Rows.Count).End(xlUp)).Name = "Dynamic"
        
        .cmbFullName.RowSource = "Dynamic"
        
        

        .txtDate.Value = ""
        .txtDescription.Value = ""
        
        'Below code are associated with Search Feature - Part 3
        
        Call Add_SearchColumn
        ThisWorkbook.Sheets("Database").AutoFilterMode = False
        ThisWorkbook.Sheets("SearchData").AutoFilterMode = False
        ThisWorkbook.Sheets("SearchData").Cells.Clear
        
        '--------------------------------------
        
        .lstDatabase.ColumnCount = 8
        .lstDatabase.ColumnHeads = True
        
        .lstDatabase.ColumnWidths = "55,40,40,50,20,150,40,150"
        
        If iRow > 1 Then
        
            .lstDatabase.RowSource = "Database!A2:H" & iRow
        Else
            
            .lstDatabase.RowSource = "Database!A2:H2"
        End If
           
        
    End With

End Sub

Sub Submit()

    Dim sh As Worksheet
    Dim iRow As Long
    
    Set sh = ThisWorkbook.Sheets("Database")
    
    If FrmForm.txtRowNumber.Value = "" Then
    
        iRow = [Counta(Database!A:A)] + 1
    Else
    
        iRow = FrmForm.txtRowNumber.Value
    
    End If
    
    With sh
        
        .Cells(iRow, 1) = [Text(),"*"]
        
        .Cells(iRow, 2) = FrmForm.cmbFileNo.Value
        
        .Cells(iRow, 3) = FrmForm.cmbType.Value
        
        .Cells(iRow, 4) = FrmForm.cmbEvent.Value
        
        .Cells(iRow, 5) = FrmForm.cmbExt.Value
        
        .Cells(iRow, 6) = FrmForm.cmbFullName.Value
        
        .Cells(iRow, 7) = FrmForm.txtDate.Value
        
        .Cells(iRow, 8) = FrmForm.txtDescription.Value
        
        
    End With
        

End Sub

Sub Show_Form()

    FrmForm.Show
    
End Sub


Function Selected_List() As Long

    Dim I As Long
    
    Selected_List = 0
    
    For H = 0 To FrmForm.lstDatabase.ListCount - 1
    
        If FrmForm.lstDatabase.Selected(H) = True Then
        
            Selected_List = H + 1
            Exit For
        End If
        
    Next H
    
End Function


Sub Add_SearchColumn()

    FrmForm.EnableEvents = False
    
    With FrmForm.cmbSearchColumn
    
        .Clear
        
        .AddItem "All"
        
        .AddItem "File Name"
        .AddItem "File No."
        .AddItem "File Type"
        .AddItem "Event"
        .AddItem "Full Name & YOB"
        .AddItem "Hyperlink"
        .AddItem "Est. Date of Event"
        .AddItem "Despcription"
        
        .Value = "All"
        
    End With
    
    FrmForm.EnableEvents = True
    
    FrmForm.txtSearch.Value = ""
    FrmForm.txtSearch.Enabled = False
    FrmForm.cmdSearch.Enabled = False
        
End Sub


Sub SearchData()

    Application.ScreenUpdating = False
    
    Dim shDatabase As Worksheet ' Database Sheet
    Dim shSearchData As Worksheet 'SearchData Sheet"
    
    Dim iColumn As Integer 'To hold the selected column number in Database sheet
    Dim iDatabaseRow As Long 'To store the last non-blank row number available in Database sheet
    Dim iSearchRow As Long 'To hold thelast non-blank row number available in SearchData sheet
    
    Dim sColumn As String 'To store the column selection
    Dim sValue As String 'To hold the search text value
    
    Set shDatabase = ThisWorkbook.Sheets("Database")
    Set shSearchData = ThisWorkbook.Sheets("SearchData")
    
    iDatabaseRow = ThisWorkbook.Sheets("Database").Range("A" & Application.Rows.Count).End(xlUp).Row
    
    sColumn = FrmForm.cmbSearchColumn.Value
    
    sValue = FrmForm.txtSearch.Value
    
    iColumn = Application.WorksheetFunction.Match(sColumn, shDatabase.Range("A1:H1"), 0)
    
    'Remove filter from Database worksheet
    
    If shDatabase.FilterMode = True Then
    
        shDatabase.AutoFilterMode = False
    
    End If
    
    'Apply filter on database worksheet
    
    If shDatabase.FilterMode = True Then
    
        shDatabase.AutoFilterMode = False
        
    End If
    
    'Apply Data on Database worksheet
    
    If FrmForm.cmbSearchColumn.Value = "File No." Then
    
        shDatabase.Range("A1:H" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:=sValue
    
    Else
    
         shDatabase.Range("A1:H" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:="*" & sValue & "*"
     
     End If
    
    If Application.WorksheetFunction.Subtotal(3, shDatabase.Range("C:C")) >= 2 Then
    
        'Code to remove the previous data from SearchData worksheet
        
        shSearchData.Cells.Clear
        
        shDatabase.AutoFilter.Range.Copy shSearchData.Range("A1")
        
        Application.CutCopyMode = False
        
        iSearchRow = shSearchData.Range("A" & Application.Rows.Count).End(xlUp).Row
        
        FrmForm.lstDatabase.ColumnCount = 8
        
        FrmForm.lstDatabase.ColumnWidths = "55, 40, 40, 50, 20, 150, 40, 150"
        
        If iSearchRow > 1 Then
        
            FrmForm.lstDatabase.RowSource = "SearchData!A2:i" & iSearchRow
            
            MsgBox "Records Found."
            
        End If
        
    Else
    
        MsgBox "No record found."
    
    End If
    
    shDatabase.AutoFilterMode = False
    Application.ScreenUpdating = True
    
End Sub




Sub Reset()

    Dim iRow As Long
    iRow = [Counta(Database!A:A)] ' identifying the last row
    
    With FrmForm

        .cmbFileNo.Value = Clear
        
        'Creating Dynamic Name for FileNo.
        
        shUnused.Range("E2", shUnused.Range("E" & Application.Rows.Count).End(xlUp)).Name = "UnusedNo"
        
        .cmbFileNo.RowSource = "UnusedNo"
            
        
        .cmbType.Value = Clear
        
        .cmbType.AddItem "File"
        .cmbType.AddItem "Picture"
        .cmbType.AddItem "Website"
        
              
        .cmbEvent.Value = Clear
        
        .cmbEvent.AddItem "Birth"
        .cmbEvent.AddItem "Burial"
        .cmbEvent.AddItem "Christening"
        .cmbEvent.AddItem "Death"
        .cmbEvent.AddItem "Individual"
        .cmbEvent.AddItem "Marriage"
        .cmbEvent.AddItem "Residence"
        
        
        .cmbExt.Value = Clear
        
        .cmbExt.AddItem "pdf"
        .cmbExt.AddItem "jpg"
        
        
        .cmbFullName.Value = Clear
        
        'Creating Dynamic Name for Full Name
        
        shNameWks.Range("A2", shNameWks.Range("A" & Application.Rows.Count).End(xlUp)).Name = "Dynamic"
        
        .cmbFullName.RowSource = "Dynamic"
        
        

        .txtDate.Value = ""
        .txtDescription.Value = ""
        
        'Below code are associated with Search Feature - Part 3
        
        Call Add_SearchColumn
        ThisWorkbook.Sheets("Database").AutoFilterMode = False
        ThisWorkbook.Sheets("SearchData").AutoFilterMode = False
        ThisWorkbook.Sheets("SearchData").Cells.Clear
        
        '--------------------------------------
        
        .lstDatabase.ColumnCount = 8
        .lstDatabase.ColumnHeads = True
        
        .lstDatabase.ColumnWidths = "55,40,40,50,20,150,40,150"
        
        If iRow > 1 Then
        
            .lstDatabase.RowSource = "Database!A2:H" & iRow
        Else
            
            .lstDatabase.RowSource = "Database!A2:H2"
        End If
           
        
    End With

End Sub

Sub Submit()

    Dim sh As Worksheet
    Dim iRow As Long
    
    Set sh = ThisWorkbook.Sheets("Database")
    
    If FrmForm.txtRowNumber.Value = "" Then
    
        iRow = [Counta(Database!A:A)] + 1
    Else
    
        iRow = FrmForm.txtRowNumber.Value
    
    End If
    
    With sh
        
        .Cells(iRow, 1) = [Text(),"*"]
        
        .Cells(iRow, 2) = FrmForm.cmbFileNo.Value
        
        .Cells(iRow, 3) = FrmForm.cmbType.Value
        
        .Cells(iRow, 4) = FrmForm.cmbEvent.Value
        
        .Cells(iRow, 5) = FrmForm.cmbExt.Value
        
        .Cells(iRow, 6) = FrmForm.cmbFullName.Value
        
        .Cells(iRow, 7) = FrmForm.txtDate.Value
        
        .Cells(iRow, 8) = FrmForm.txtDescription.Value
        
        
    End With
        

End Sub

Sub Show_Form()

    FrmForm.Show
    
End Sub


Function Selected_List() As Long

    Dim I As Long
    
    Selected_List = 0
    
    For H = 0 To FrmForm.lstDatabase.ListCount - 1
    
        If FrmForm.lstDatabase.Selected(H) = True Then
        
            Selected_List = H + 1
            Exit For
        End If
        
    Next H
    
End Function


Sub Add_SearchColumn()

    FrmForm.EnableEvents = False
    
    With FrmForm.cmbSearchColumn
    
        .Clear
        
        .AddItem "All"
        
        .AddItem "File Name"
        .AddItem "File No."
        .AddItem "File Type"
        .AddItem "Event"
        .AddItem "Full Name & YOB"
        .AddItem "Hyperlink"
        .AddItem "Est. Date of Event"
        .AddItem "Despcription"
        
        .Value = "All"
        
    End With
    
    FrmForm.EnableEvents = True
    
    FrmForm.txtSearch.Value = ""
    FrmForm.txtSearch.Enabled = False
    FrmForm.cmdSearch.Enabled = False
        
End Sub


Sub SearchData()

    Application.ScreenUpdating = False
    
    Dim shDatabase As Worksheet ' Database Sheet
    Dim shSearchData As Worksheet 'SearchData Sheet"
    
    Dim iColumn As Integer 'To hold the selected column number in Database sheet
    Dim iDatabaseRow As Long 'To store the last non-blank row number available in Database sheet
    Dim iSearchRow As Long 'To hold thelast non-blank row number available in SearchData sheet
    
    Dim sColumn As String 'To store the column selection
    Dim sValue As String 'To hold the search text value
    
    Set shDatabase = ThisWorkbook.Sheets("Database")
    Set shSearchData = ThisWorkbook.Sheets("SearchData")
    
    iDatabaseRow = ThisWorkbook.Sheets("Database").Range("A" & Application.Rows.Count).End(xlUp).Row
    
    sColumn = FrmForm.cmbSearchColumn.Value
    
    sValue = FrmForm.txtSearch.Value
    
    iColumn = Application.WorksheetFunction.Match(sColumn, shDatabase.Range("A1:H1"), 0)
    
    'Remove filter from Database worksheet
    
    If shDatabase.FilterMode = True Then
    
        shDatabase.AutoFilterMode = False
    
    End If
    
    'Apply filter on database worksheet
    
    If shDatabase.FilterMode = True Then
    
        shDatabase.AutoFilterMode = False
        
    End If
    
    'Apply Data on Database worksheet
    
    If FrmForm.cmbSearchColumn.Value = "File No." Then
    
        shDatabase.Range("A1:H" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:=sValue
    
    Else
    
         shDatabase.Range("A1:H" & iDatabaseRow).AutoFilter Field:=iColumn, Criteria1:="*" & sValue & "*"
     
     End If
    
    If Application.WorksheetFunction.Subtotal(3, shDatabase.Range("C:C")) >= 2 Then
    
        'Code to remove the previous data from SearchData worksheet
        
        shSearchData.Cells.Clear
        
        shDatabase.AutoFilter.Range.Copy shSearchData.Range("A1")
        
        Application.CutCopyMode = False
        
        iSearchRow = shSearchData.Range("A" & Application.Rows.Count).End(xlUp).Row
        
        FrmForm.lstDatabase.ColumnCount = 8
        
        FrmForm.lstDatabase.ColumnWidths = "55, 40, 40, 50, 20, 150, 40, 150"
        
        If iSearchRow > 1 Then
        
            FrmForm.lstDatabase.RowSource = "SearchData!A2:i" & iSearchRow
            
            MsgBox "Records Found."
            
        End If
        
    Else
    
        MsgBox "No record found."
    
    End If
    
    shDatabase.AutoFilterMode = False
    Application.ScreenUpdating = True
    
End Sub

USER FORM VBA

VBA Code:

Option Explicit
Public EnableEvents As Boolean


Private Sub cmbDelete_Click()

    Dim iRow As Long

    If Selected_List = 0 Then
    
        MsgBox "No row is selected.", vbOKOnly + vbInformation, "Delete"
        Exit Sub
    End If
    
    Dim I As VbMsgBoxResult
    
    I = MsgBox("Do you want to delete the selected record?", vbYesNo + vbQuestion, "Confirmation")
    
    If I = vbNo Then Exit Sub
    
    iRow = Application.WorksheetFunction.Match(Me.lstDatabase.List(Me.lstDatabase.ListIndex, 0), _
    ThisWorkbook.Sheets("Database").Range("A:A"), 0)
    
    ThisWorkbook.Sheets("Database").Rows(iRow).Delete
    
    Call Reset
    

End Sub

Private Sub cmbEdit_Click()

    If Selected_List = 0 Then
    
        MsgBox "No row is selected.", vbOKOnly + vbInformation, "Edit"
        
        Exit Sub
        
    End If
    
    'Code to update the value to respective controls
    
    Dim sGender As String
    
    Me.txtRowNumber.Value = Application.WorksheetFunction.Match(Me.lstDatabase.List(Me.lstDatabase.ListIndex, 0), _
    ThisWorkbook.Sheets("Database").Range("A:A"), 0)
    
    
    Me.cmbFileNo.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 1)
    
    Me.cmbType.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 2)
    
    Me.cmbEvent.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 3)
    
    Me.cmbExt.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 4)
    
    Me.cmbFullName.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 5)
    
    Me.txtDate.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 6)
    
    Me.txtDescription.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 7)
    
    MsgBox "Please make the required changes and click on 'Save' button to update.", vbOKOnly + vbInformation, "Edit"

End Sub

Private Sub cmbSearchColumn_Change()

    If Me.EnableEvents = False Then Exit Sub
    
    If Me.cmbSearchColumn.Value = "All" Then
    
        Call Reset
    Else
    
        Me.txtSearch.Value = ""
        Me.txtSearch.Enabled = True
        Me.cmdSearch.Enabled = True
     
    End If


End Sub

Private Sub cmdReset_Click()
    Dim msgValue As VbMsgBoxResult
    
    msgValue = MsgBox("Do you want to reset the form?", vbYesNo + vbInformation, "Confirmation")
    
    If msgValue = vbNo Then Exit Sub
    
    Call Reset
End Sub

Private Sub cmdSave_Click()

Dim msgValue As VbMsgBoxResult
    Dim sh4 As Worksheet
    Dim sh2 As Worksheet
    Dim iRow As Long
   
   
    Set sh4 = ThisWorkbook.Sheets("File Name Sheet")
    Set sh2 = ThisWorkbook.Sheets("Database")
   
'File Name Sheet
    With sh4
        .Range("J12").Value = Me.cmbFileNo.Value
        .Range("K12").Value = Me.cmbType.Value
        .Range("L12").Value = Me.cmbEvent.Value
        .Range("M12").Value = Me.cmbExt.Value
    End With
   

    If Val(Me.txtRowNumber.Value) = 0 Then
   
'Get Next Row

        iRow = [Counta(Database!A:A)] + 1
       
'OR use common method to find lastrow in worksheet range
       ' iRow = sh2.Cells(sh2.Rows.Count, "A").End(xlUp).Row + 1
    Else
       
        iRow = Val(Me.txtRowNumber.Value)
       
    End If
   
'Database Sheet
    With sh2
       
        .Cells(iRow, 1) = sh4.Range("I12").Value
       
    End With
   
'Ask user for response
    msgValue = MsgBox("Do Something Else?", 36, "Do Something")
    If msgValue = vbNo Then Exit Sub
   
    Call Submit
    Call Reset
   
End Sub

Private Sub cmdSearch_Click()

    If Me.txtSearch.Value = "" Then
    
        MsgBox "Please enter the search value.", vbOKOnly + vbInformation, "Search"
        Exit Sub
        
    End If
    
    Call SearchData
        
End Sub

Private Sub txtDespcription_Change()



End Sub


Private Sub txtNumber_Change()


End Sub

Private Sub txtDescription_Change()

End Sub

Private Sub UserForm_Initialize()

    Call Reset

End Sub

dmt32 · Feb 22, 2020

dellehurley said:
Hi Dave

I have attached everything this time (I hope you meant this literally ) but before I do I will point out that there is a bug with the delete code.
It was working but obviously one of my changes has mucked it up, it is next on my to do list.

Dannielle

Hi,
sorry meant to include possible to place copy of your workbook in a dropbox & provide a link to it here?

Dave

dellehurley · Feb 22, 2020

I thought it would be difficult to understand that way. Here is a link to the file.

Dropbox

www.dropbox.com

dmt32 · Feb 23, 2020

Hi,
try replacing your forms cmdSave_Click code with following & see if update does what you want

VBA Code:

Private Sub cmdSave_Click()

    Dim msgValue As VbMsgBoxResult
    Dim iRow As Long
    Dim Response As VbMsgBoxResult
    Dim sh2 As Worksheet
   
    Set sh2 = ThisWorkbook.Sheets("Database")

   
'Ask user for response
    Response = MsgBox("Submit Record To Database?", 36, "Submit Record")
    If Response = vbNo Then Exit Sub
   
    With sh2
    iRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
        .Cells(iRow, 1) = Left(Me.cmbType, 1) & Left(Me.cmbEvent, 2) & Format(Me.cmbFileNo, "0000") & "." & Me.cmbExt
        .Cells(iRow, 2) = Me.cmbFileNo.Value
        .Cells(iRow, 3) = Me.cmbType.Value
        .Cells(iRow, 4) = Me.cmbEvent.Value
        .Cells(iRow, 5) = Me.cmbExt.Value
        .Cells(iRow, 6) = Me.cmbFullName.Value
        .Cells(iRow, 7) = Me.txtDate.Value
        .Cells(iRow, 8) = Me.txtDescription.Value
    End With

    MsgBox "Record Submitted", 64, "Record Submitted"
    
    Call Reset
   
End Sub

Dave

dellehurley · Feb 24, 2020

Thanks Dave that works perfectly.
One more question if I am not pushing my luck.
The file name in column A corresponds with a file by the same name in the same folder as Database. Ideally it would open if I double clicked on the line in the bottom section of the user form or if the line is selected and press open.
I know the code will be similar to that in delete and submit buttons but I cannot get my head around how to write it. The most recent version is in the dropbox file.
Thanks again.
Dannielle

dmt32 · Feb 24, 2020

Hi,
your updated file link does not work but no worries

Try these updated codes in your userform & see if will do what you want

VBA Code:

Private Sub cmbDelete_Click()

    Dim Response As VbMsgBoxResult
    Dim iRow As Long
    Dim FileName As String
    
    With Me.lstDatabase
        iRow = .ListIndex + 2
        FileName = .Column(0)
    End With
    
    Response = MsgBox("File Name: " & FileName & Chr(10) & "Do you want to delete the selected record?", vbYesNo + vbQuestion, "Confirmation")
    If Response = vbNo Then Exit Sub
    
    Me.lstDatabase.RowSource = ""
    
    ThisWorkbook.Sheets("Database").Rows(iRow).EntireRow.Delete
    
    MsgBox "File Name: " & FileName & Chr(10) & "Record Deleted", 48, "Record Deleted"
    
    Call Reset
    

End Sub

Private Sub cmbEdit_Click()
    Dim rng As Range

    If Selected_List = 0 Then
    
        MsgBox "No row is selected.", vbOKOnly + vbInformation, "Edit"
        
        Exit Sub
        
    End If
    
    Set rng = ThisWorkbook.Sheets("Database").Range("A:A")
    
    'Code to update the value to respective controls
    
    With Me.lstDatabase
    Me.txtRowNumber.Value = Application.Match(.List(.ListIndex, 0), rng, 0)
        Me.cmbFileNo.Value = .List(.ListIndex, 1)
        Me.cmbType.Value = .List(.ListIndex, 2)
        Me.cmbEvent.Value = .List(.ListIndex, 3)
        Me.cmbExt.Value = .List(.ListIndex, 4)
        Me.cmbFullName.Value = .List(.ListIndex, 5)
        Me.txtDate.Value = .List(.ListIndex, 6)
        Me.txtDescription.Value = .List(.ListIndex, 7)
    End With
    
    MsgBox "Please make the required changes and click on 'Save' button to update.", vbOKOnly + vbInformation, "Edit"
    Me.Tag = "UPDATE"
End Sub

Private Sub cmdSave_Click()
    Dim FileName As String, msg As String
    Dim iRow As Long
    Dim UpdateRecord As Boolean
    Dim Response As VbMsgBoxResult
    Dim sh2 As Worksheet
   
    Set sh2 = ThisWorkbook.Sheets("Database")
    
    UpdateRecord = CBool(Me.Tag = "UPDATE")
    
    FileName = Left(Me.cmbType, 1) & Left(Me.cmbEvent, 2) & Format(Me.cmbFileNo, "0000") & "." & Me.cmbExt
   
'Ask user for response
    Response = MsgBox(FileName & Chr(10) & IIf(UpdateRecord, "Update", "Submit") & " Record To Database?", 36, "Submit Record")
    If Response = vbNo Then Exit Sub
   
    
    With sh2
    iRow = IIf(UpdateRecord, Val(Me.txtRowNumber.Value), .Cells(.Rows.Count, "A").End(xlUp).Row + 1)
        .Cells(iRow, 1) = FileName
        .Cells(iRow, 2) = Me.cmbFileNo.Value
        .Cells(iRow, 3) = Me.cmbType.Value
        .Cells(iRow, 4) = Me.cmbEvent.Value
        .Cells(iRow, 5) = Me.cmbExt.Value
        .Cells(iRow, 6) = Me.cmbFullName.Value
        .Cells(iRow, 7) = Me.txtDate.Value
        .Cells(iRow, 8) = Me.txtDescription.Value
    End With
    msg = IIf(UpdateRecord, "Record Updated", "Record Submitted")
    MsgBox FileName & Chr(10) & msg, 64, msg
    Me.Tag = ""
    Call Reset
   
End Sub

Private Sub lstDatabase_Click()
    Me.cmbDelete.Enabled = Me.lstDatabase.ListCount > 0
    Me.cmbEdit.Enabled = Me.lstDatabase.ListCount > 0
End Sub

Private Sub lstDatabase_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim FolderName As String, FileName As String
    Dim wb As Workbook
    
'change folder path to database if required
    FolderName = ThisWorkbook.Path & "\"
    
    FileName = Me.lstDatabase.Value

    On Error Resume Next
'check if file already open
        Set wb = Workbooks(FileName)
    On Error GoTo myerror
        If wb Is Nothing Then
'open file
            Set wb = Workbooks.Open(FolderName & FileName, False, False)
        End If
        
    
    'do any stuff required here

'report errors
myerror:
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Dave

dellehurley · Feb 24, 2020

Thank you Dave. You have been a real help. I have a long way to go with VBA but I feel like I understand the basics now AND I have a working database.

dmt32 · Feb 25, 2020

dellehurley said:
Thank you Dave. You have been a real help. I have a long way to go with VBA but I feel like I understand the basics now AND I have a working database.

Most welcome glad suggestions helping

I did spot some potential issues after I posted & you may want to use the updated codes below

VBA Code:

Private Sub cmbDelete_Click()

    Dim Response As VbMsgBoxResult
    Dim iRow As Long
    Dim FileName As String
    
    iRow = Val(Me.txtRowNumber.Value)
    If iRow = 0 Then Exit Sub
    FileName = Me.lstDatabase.Column(0)

    Response = MsgBox("File Name: " & FileName & Chr(10) & _
    "Do you want to delete the selected record?", 36, "Confirmation")
    If Response = vbNo Then Exit Sub
    
    Me.lstDatabase.RowSource = ""
    
    ThisWorkbook.Sheets("Database").Rows(iRow).EntireRow.Delete
    
    Call Reset
    
    MsgBox "File Name: " & FileName & Chr(10) & "Record Deleted", 48, "Record Deleted"
    
End Sub

Private Sub cmbEdit_Click()
'Code to update the value to respective controls
    With Me.lstDatabase
        Me.cmbFileNo.Value = .List(.ListIndex, 1)
        Me.cmbType.Value = .List(.ListIndex, 2)
        Me.cmbEvent.Value = .List(.ListIndex, 3)
        Me.cmbExt.Value = .List(.ListIndex, 4)
        Me.cmbFullName.Value = .List(.ListIndex, 5)
        Me.txtDate.Value = .List(.ListIndex, 6)
        Me.txtDescription.Value = .List(.ListIndex, 7)
    End With
    
    MsgBox "Please make the required changes and click on 'Save' button to update.", vbOKOnly + vbInformation, "Edit"
    Me.Tag = "UPDATE"
End Sub

Private Sub cmdSave_Click()
    Dim FileName As String, msg As String
    Dim iRow As Long
    Dim ctrl As Variant
    Dim UpdateRecord As Boolean
    Dim Response As VbMsgBoxResult
    Dim sh2 As Worksheet
    
'check values from comboboxes selected
    For Each ctrl In Array(Me.cmbFileNo, Me.cmbType, Me.cmbEvent, Me.cmbExt, cmbFullName)
        With ctrl
            If Len(.Value) = 0 Then
                MsgBox "Entry Required", 48, "Entry Required"
                .SetFocus
                Exit Sub
            End If
        End With
    Next ctrl
   
    Set sh2 = ThisWorkbook.Sheets("Database")
    
    UpdateRecord = CBool(Me.Tag = "UPDATE")
    
    FileName = Left(Me.cmbType, 1) & Left(Me.cmbEvent, 2) & Format(Me.cmbFileNo, "0000") & "." & Me.cmbExt
   
'Ask user for response
    Response = MsgBox(FileName & Chr(10) & IIf(UpdateRecord, "Update", "Submit") & " Record To Database?", 36, "Submit Record")
    If Response = vbNo Then Exit Sub
   
    
    With sh2
    iRow = IIf(UpdateRecord, Val(Me.txtRowNumber.Value), .Cells(.Rows.Count, "A").End(xlUp).Row + 1)
        .Cells(iRow, 1) = FileName
        .Cells(iRow, 2) = Me.cmbFileNo.Value
        .Cells(iRow, 3) = Me.cmbType.Value
        .Cells(iRow, 4) = Me.cmbEvent.Value
        .Cells(iRow, 5) = Me.cmbExt.Value
        .Cells(iRow, 6) = Me.cmbFullName.Value
        .Cells(iRow, 7) = Me.txtDate.Value
        .Cells(iRow, 8) = Me.txtDescription.Value
    End With
    msg = IIf(UpdateRecord, "Record Updated", "Record Submitted")
    MsgBox FileName & Chr(10) & msg, 64, msg
    Me.Tag = ""
    Call Reset
   
End Sub

Private Sub lstDatabase_Click()
    Dim rng As Range
    Dim rowno As Variant
    Set rng = ThisWorkbook.Sheets("Database").Range("A:A")
    With Me.lstDatabase
        rowno = Application.Match(.List(.ListIndex, 0), rng, 0)
    End With
        Me.txtRowNumber.Value = IIf(IsError(rowno), 0, rowno)
        Me.cmbEdit.Enabled = Val(Me.txtRowNumber.Value) > 0
        Me.cmbDelete.Enabled = Me.cmbEdit.Enabled
        Set rng = Nothing
End Sub

Private Sub lstDatabase_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim FolderName As String, FileName As String
    Dim wb As Workbook
    
'change folder path to database if required
    FolderName = ThisWorkbook.Path & "\"
    
    FileName = Me.lstDatabase.Value

    On Error Resume Next
'check if file already open
        Set wb = Workbooks(FileName)
    On Error GoTo myerror
        If wb Is Nothing Then
'open file
            Set wb = Workbooks.Open(FolderName & FileName, False, False)
        End If
        
    
    'do any stuff required here

'report errors
myerror:
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Dave

Next Row VBA issue - Beginner

dellehurley

Board Regular

Excel Facts

dmt32

Well-known Member

dellehurley

Board Regular

dmt32

Well-known Member

dellehurley

Board Regular

Dropbox

dmt32

Well-known Member

dellehurley

Board Regular

dmt32

Well-known Member

dellehurley

Board Regular

dmt32

Well-known Member

Similar threads

Forum statistics

Share this page

Next Row VBA issue - Beginner

Board Regular

Excel Facts

Well-known Member

Board Regular

Well-known Member

Board Regular

Well-known Member

Board Regular

Well-known Member

Board Regular

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock