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
LinkBack URL
About LinkBacks
Dabbler39 
Register To Reply
My goto's are working fine and my code works fine with the exception of the aforementioned issue. That being said, are you suggesting a better way of peeling the apple with the goto's? As I am a newb, I am always open to suggestions!!! If we're not learning, we're dead. I will upload my file when I get home tonight. Thank you for your help.
below the post.
Bookmarks