Private Sub OK_Click()
Dim ACTVSHT As Worksheet, _
SETUPSHT As Worksheet, _
LastRow As Long, _
Rng As Range, _
Rang As Range, _
Addr As String
Set ACTVSHT = ThisWorkbook.ActiveSheet
Set SETUPSHT = ThisWorkbook.Sheets("Initial Setup")
ScreenUpdating = False
If IND.Value = True And IASUB = True And Trim(NAM) <> "" Then
With SETUPSHT.Range("p6002:r13999")
Set Rang = .Find(What:=NAM, _
LookIn:=xlValues, _
LookAt:=xlPart)
'---------------------------------------------------------------------------------------------
If Not Rang Is Nothing Then
Do
Addr = Rang.Address
addr1 = Rang.Offset(0, -4).Value
addr2 = Rang.Offset(0, -2).Value
addr3 = Rang.Offset(0, -6).Value
UseNAM = MsgBox("There is UseNAM " & Rang & ", " & Format(addr1, "(###) ###-####") & " in " & addr3 & ", " & ". Would You like to use this one?", vbYesNoCancel)
Select Case UseNAM
Case Is = vbYes
If ACTVSHT.Range("d57").Value <> "" And ACTVSHT.Range("d61").Value <> "" Then
ReplaceIA = MsgBox("There are no Open IA slots on this claim. Would you like to replace one?", vbYesNoCancel)
Select Case ReplaceIA
Case Is = vbNo
MsgBox ("Unable to add IA. Both slots are taken. Consider removing one that you are not using anymore.")
Exit Do
Case Is = vbYes
ReplaceIA_1 = MsgBox("Would you like to replace IA #1?", vbYesNoCancel)
Select Case ReplaceIA_1
Case Is = vbNo
With ACTVSHT
.Range("d61:d63").Value = Array(Rang, addr1, addr2)
.Range("d60:d63").EntireRow.Hidden = False
End With
Case Is = vbYes
With ACTVSHT
.Range("d57:d59").Value = Array(Rang, addr1, addr2)
.Range("d56:d59").EntireRow.Hidden = False
End With
End Select 'ReplaceIA_1
End Select 'ReplaceIA
End Select 'UseNAM
Set Rang = .FindNext(Rang)
Loop While Not Rang Is Nothing And Rang.Address <> Addr
'==============================================================================
Else 'rang is nothing
NewRec = MsgBox("This Individual will be added to the database for future use. Is that okay?", vbYesNoCancel)
If NewRec = vbYes Then
With ACTVSHT
LastRow = .Range("p6002:r13999").End(xlDown).Row + 1
.Cells(LastRow, 1).Value = COM.Value
.Cells(LastRow, 4).Value = TAX.Value
.Cells(LastRow, 6).Value = Add.Value
.Cells(LastRow, 9).Value = CIT.Value
.Cells(LastRow, 10).Value = STA.Value
.Cells(LastRow, 11).Value = ZIP.Value
.Cells(LastRow, 12).Value = PHO.Value
.Cells(LastRow, 14).Value = EMA.Value
.Cells(LastRow, 16).Value = NAM.Value
.Cells(LastRow, 19).Value = "IA"
End With 'ACTVSHT
If ACTVSHT.Range("d57").Value <> "" And ACTVSHT.Range("d61").Value <> "" Then
ReplaceIA = MsgBox("There are no Open IA slots on this claim. Would you like to replace one?", vbYesNoCancel)
Select Case ReplaceIA
Case Is = vbNo
MsgBox ("Unable to add IA. Both slots are taken. Consider removing one that you are not using anymore.")
Case Is = vbYes
RelplaceIA_1 = MsgBox("Would you like to replace IA #1?", vbYesNoCancel)
Select Case RelplaceIA_1
Case Is = vbNo
ACTVSHT.Range("d61:D63").Value = Array(NAM, PHO, EMA)
Case Is = vbYes
ACTVSHT.Range("d57:d59").Value = Array(NAM, PHO, EMA)
ACTVSHT.Range("d56:d59").EntireRow.Hidden = False
End Select
End Select
Else
If Range("d61") = "" Then
ACTVSHT.Range("d61:D63").Value = Array(NAM, PHO, EMA)
End If
If Range("d57") = "" Then
ACTVSHT.Range("d57:d59").Value = Array(NAM, PHO, EMA)
ACTVSHT.Range("d56:d59").EntireRow.Hidden = False
End If
End If
End If
End With 'SETUPSHT
End If 'IND.VALUE
ScreenUpdating = True
Unload Me
End Sub
Bookmarks