Userform Database call Function & Concatenating issues.

[dellehurley]

Hi
I have an existing userform which I have been slowly building up and adjusting. I also have and a function named concatif. The function looks in the database for filenames which match and concatenates the names of the people linked to that file in the description.
I have tried to write the code but it has errors and I cannot figure out how to fix them. Please help.
Before I made these changes the user form sent the information from textbox named Description to column I.
What I am trying to do..... if the txtDescription is empty - run the function - then concatenate the text from cmbFullName and the function result and place the answer in column I.
OR if Description contains text run the function - then concatenate the text from txtDescription, cmbFullName and the function result and place the answer in column I.

The function is as follows (does not need to be separate but I cannot figure out how to add it into the sub routine).

 Function ConcatIf(ConcatRange As Variant, criteriaRange As Variant, criteria As String, MySep As String) As String
'concats items in a range based on criteria | works much like a sum if
Dim currentstring As String
currentstring = ""
    For i = 1 To ConcatRange.Count
            If criteriaRange(i) = criteria Then
            currentstring = currentstring & ConcatRange(i) & MySep
            End If
    Next i
currentstring = Left(currentstring, Len(currentstring) - Len(MySep))
ConcatIf = currentstring
End Function

The code for the save routine is as follows-

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
    Dim result As String
    Dim currentstring As String
    
'check values from comboboxes selected
    For Each ctrl In Array(Me.txtFileNo, 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.txtFileNo, "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.txtFileNo.Value
        .Cells(iRow, 3) = Me.cmbType.Value
        .Cells(iRow, 4) = Me.cmbEvent.Value
        .Cells(iRow, 5) = Me.cmbExt.Value
        .Cells(iRow, 6) = Me.txtRIN.Value
        .Cells(iRow, 7) = Me.cmbFullName.Value
        .Cells(iRow, 8) = Me.txtDate.Value
        
        'Call ConcatIf function
        Call ConcatIf(ThisWorkbook.Sheets("Database").Range("G:G"), ThisWorkbook.Sheets("Database").Range("A:A"), Cells(Rows.Count, 1).End(xlUp).Row, "  /  ")
            
        result = currentstring
        'if description is empty concatenate cmbFullName & Concatif results
        If Me.txtDescription.Value = "" Then
        .Cells(iRow, 9) = Me.cmbFullName.Value & ("  /  ") & result
        'if Description box not empty concatendate txtDescription, cmbFullName and Concatif results
        ElseIf .Cells(iRow, 9) = Me.txtDescription.Value & ("  /  ") & Me.cmbFullName.Value & ("  /  ") & result
        End If
    
    End With
    msg = IIf(UpdateRecord, "Record Updated", "Record Submitted")
    MsgBox FileName & Chr(10) & msg, 64, msg
    Me.Tag = ""
    Call Reset

   
End Sub

I will give a link to the file too.
Open File Here

Thank in advance.
Dannielle

 

[GWteB]

I haven't analyzed all your code, but I think this fragment ....

'Call ConcatIf function
Call ConcatIf(ThisWorkbook.Sheets("Database").Range("G:G"), ThisWorkbook.Sheets("Database").Range("A:A"), Cells(Rows.Count, 1).End(xlUp).Row, "  /  ")
result = currentstring

needs to be changed in ....

result = ConcatIf(ThisWorkbook.Sheets("Database").Range("G:G"), ThisWorkbook.Sheets("Database").Range("A:A"), Cells(Rows.Count, 1).End(xlUp).Row, "  /  ")

 

[dellehurley]

I haven't analyzed all your code, but I think this fragment ....

'Call ConcatIf function
Call ConcatIf(ThisWorkbook.Sheets("Database").Range("G:G"), ThisWorkbook.Sheets("Database").Range("A:A"), Cells(Rows.Count, 1).End(xlUp).Row, "  /  ")
result = currentstring

needs to be changed in ....

result = ConcatIf(ThisWorkbook.Sheets("Database").Range("G:G"), ThisWorkbook.Sheets("Database").Range("A:A"), Cells(Rows.Count, 1).End(xlUp).Row, "  /  ")

Thanks for the reply. I think I am going to have to abandon this idea, it is making the userform exceptionally slow, pity.

 

[GWteB]

You are welcome and thanks for the feedback.