Making a Database out of Excel

[jackdandcoke]

Firefytr has been gracious enough to start a project for me that essentially turns excel into a database. What has to happen is I need to send an excel file that allows my clients to enter data in on the "Data Entry" sheet that stores it on seperate lines on the the "Records sheet".

The Data Entry sheet changes appearance based on the selection in cell B6 by hiding cells. The sheet is exactly the format that I want except the code doesn't execute to the fullest. It requires that entries be made in the O, I, and P, options in stead of just one or more. When you click the button it checks to see if there's something in every cell before logging those entries on the "Records" sheet. I've attached the file so feel free to tinker with it. If you need more clarification [which I'm sure you will] please ask.

[jackdandcoke]

Private Sub cmbAddRecord_Click()
Dim ws As Worksheet, iRow As Long, sRngName As String, msgDup As VbMsgBoxResult
Dim arrVals() As String, i As Long, iUpper As Long, rngTemp As Range, bDel As Boolean
Select Case Me.Range("RecType").Value
Case "O": sRngName = "RecTypeO"
Case "I": sRngName = "RecTypeI"
Case "P": sRngName = "RecTypeP"
Case Else
Exit Sub
End Select
Call ToggleEvents(False)
Set ws = ThisWorkbook.Sheets("Records")
iRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
If WorksheetFunction.CountA(Me.Range("B6:D6")) <> 3 Then
MsgBox "You need to fill out the header data!", vbExclamation, "ERROR!"
GoTo TheEnd
End If
Select Case sRngName
Case "RecTypeO"
iUpper = Len(Me.Range("F9").Value) - Len(WorksheetFunction.Substitute(Me.Range("F9").Value, ",", "")) + 1
ReDim arrVals(1 To iUpper)
arrVals() = Split(Me.Range("F9").Value, ",")
If ArrFull(arrVals()) = False Then
MsgBox "You have not filled out all of the data!", vbExclamation, "ERROR!"
GoTo TheEnd
End If
ws.Range("A" & iRow & ":C" & iRow).Value = Me.Range("B6:D6").Value
ws.Range("D" & iRow & ":S" & iRow).Value = arrVals()
ws.Range("T" & iRow & ":X" & iRow).Value = "-"
ws.Range("Y" & iRow & ":AP" & iRow).Value = "-"
Case "RecTypeI"
iUpper = Len(Me.Range("F24").Value) - Len(WorksheetFunction.Substitute(Me.Range("F24").Value, ",", "")) + 1
ReDim arrVals(1 To iUpper)
arrVals() = Split(Me.Range("F24").Value, ",")
If ArrFull(arrVals()) = True Then
MsgBox "You have not filled out all of the data!", vbExclamation, "ERROR!"
GoTo TheEnd
End If
ws.Range("A" & iRow & ":C" & iRow).Value = Me.Range("B6:D6").Value
ws.Range("D" & iRow & ":S" & iRow).Value = "-"
ws.Range("T" & iRow & ":X" & iRow).Value = arrVals()
ws.Range("Y" & iRow & ":AP" & iRow).Value = "-"
Case "RecTypeP"
iUpper = Len(Me.Range("F30").Value) - Len(WorksheetFunction.Substitute(Me.Range("F30").Value, ",", "")) + 1
ReDim arrVals(1 To iUpper)
arrVals() = Split(Me.Range("F30").Value, ",")
If ArrFull(arrVals()) = True Then
MsgBox "You have not filled out all of the data!", vbExclamation, "ERROR!"
GoTo TheEnd
End If
ws.Range("A" & iRow & ":C" & iRow).Value = Me.Range("B6:D6").Value
ws.Range("D" & iRow & ":S" & iRow).Value = "-"
ws.Range("T" & iRow & ":X" & iRow).Value = "-"
ws.Range("Y" & iRow & ":AP" & iRow).Value = arrVals()
End Select
'Check for duplicates
For i = 1 To 42
ws.Range("A6:AP" & iRow).AutoFilter field:=i, Criteria1:=ws.Cells(iRow, i).Value
sPipe = sPipe & ws.Cells(iRow, i).Value & sDelim
Next i
sPipe = Left(sPipe, Len(sPipe) - 1)
Set rngTemp = ws.Range("A5:AP" & iRow).SpecialCells(xlCellTypeVisible)
If rngTemp.Rows.Count > 1 Then
bDel = False
msgDup = MsgBox("You have a duplicated record! Delete duplicate?", vbYesNo, "DUPLICATE!")
If msgDup = vbYes Then
bDel = True
ws.Rows(iRow).Delete
End If
End If
ws.AutoFilterMode = False
sRngName = ""
For i = 10 To 48 Step 3
sRngName = sRngName & "B" & i & ":E" & i & ","
Next i
sRngName = Left(sRngName, Len(sRngName) - 1)
If bDel = False Then
ws.Cells(iRow, 43).Value = sPipe '.Formula = "=MCONCAT(A" & iRow & ":AP" & iRow & ",""|"")"
End If
Me.Range(sRngName).ClearContents
TheEnd:
Call ToggleEvents(True)
End Sub

This is the code to the command button, but it's not actually moving the records to the next sheet. Also, there will always be an "I" OR an "O" OR a "P" and maybe a combo but I only require that one be filled out per click, not all. Can anyone find what is wrong?