Psst.. new poll here.
Psst.. new forums here.
Microsoft is blocking us again (TY IP Reputation!) so just use oauth login instead. :)
Paste
Pasted as VBScript by Tom ( 5 years ago )
Public Override As String
Public Sub Call1()
Dim Inp As Worksheet, Tree As Worksheet
Dim I As Long
Set Inp = ThisWorkbook.Worksheets("Input Screen")
Set Tree = ThisWorkbook.Worksheets("Call Tree")
Inp.Activate
If Inp.Range("J7").Value2 = "Main" Then
Tree.Range("A2").Value2 = Inp.Range("D7").Value2
AddRepo
MsgBox ("Master Program " & Inp.Range("D3").Value2 & " was added to " & Tree.Cells(1, 1))
ElseIf Inp.Range("J7").Value2 = "Sub" Then
Set PFound = Tree.Range("A1:Z100").Find(What:=Inp.Range("D3").Value2, LookAt:=xlWhole)
If PFound Is Nothing Then
MsgBox ("Calling Program " & Inp.Range("D3").Value2 & " was not found.")
Else
For I = PFound.Row To 100
If IsEmpty(Tree.Cells(I, PFound.Column + 1)) Then
If Tree.Cells(I, PFound.Column).Value = Inp.Range("D3").Value2 Then
Tree.Cells(I, PFound.Column + 1).Value = Inp.Range("D7").Value2
AddRepo
MsgBox ("Program added to: " & Tree.Cells(1, PFound.Column + 1))
Exit For
ElseIf CheckNotEmptyL(I, PFound.Column) Then
Tree.Rows(I).Insert shift:=xlShiftDown
Tree.Cells(I, PFound.Column + 1).Value = Inp.Range("D7").Value2
AddRepo
MsgBox ("Program added to: " & Tree.Cells(1, PFound.Column + 1))
Exit For
ElseIf CheckEmptyR(I, PFound.Column) Then
'Set FindBlank = Range(FindEmptyB(I, PFound.Column))
'Tree.Rows(I).Insert shift:=xlShiftDown
Tree.Cells(I, PFound.Column + 1).Value = Inp.Range("D7").Value2
AddRepo
MsgBox ("Program added to: " & Tree.Cells(1, PFound.Column + 1))
Exit For
'Else
'Tree.Cells(I, PFound.Column + 1).Value = Inp.Range("D7").Value2
'AddRepo
'MsgBox ("Program added to: " & Tree.Cells(1, PFound.Column + 1))
'Exit For
End If
ElseIf IsEmpty(Tree.Cells(I + 1, PFound.Column)) = False Then
Tree.Rows(I + 1).Insert shift:=xlShiftDown
End If
Next I
End If
End If
End Sub
Public Function CheckNotEmptyL(thisRow As Long, thisColumn As Long)
Set Tree = ThisWorkbook.Worksheets("Call Tree")
Dim j As Long
For j = thisColumn To 1 Step -1
If IsEmpty(Tree.Cells(thisRow, j)) Then
CheckNotEmptyL = "False"
Else
CheckNotEmptyL = "True"
Exit For
End If
Next j
End Function
Public Function CheckEmptyR(thisRow As Long, thisColumn As Long)
Set Tree = ThisWorkbook.Worksheets("Call Tree")
Dim k As Long
For k = thisColumn To 50
If IsEmpty(Tree.Cells(thisRow, k)) Then
CheckEmptyR = "True"
Else
CheckEmptyR = "False"
Exit For
End If
Next k
End Function
Public Function FindEmptyB(thisRow As Long, thisColumn As Long)
Set Tree = ThisWorkbook.Worksheets("Call Tree")
Dim k As Long
For k = thisRow + 1 To 100
If IsEmpty(Tree.Cells(k, thisColumn + 1)) Then
FindEmptyB = Tree.Cells(k, thisColumn + 1).Address
Exit For
End If
Next k
End Function
Sub AddRepo()
Dim Inp As Worksheet, Tree As Worksheet
Dim Cell As Range
Dim Result As String
Dim l As Long
Dim m As Long
Set Inp = ThisWorkbook.Worksheets("Input Screen")
Set Repo = ThisWorkbook.Worksheets("Program Repository")
Set PrgmFound = Repo.Range("A1:A200").Find(Inp.Range("D7").Value2)
If PrgmFound Is Nothing Then
Override = "N"
AddPgm:
If Override <> "Y" Then
Set BFound = Repo.Range("A1:A200").Find("")
Else
Set BFound = PrgmFound
End If
Repo.Cells(BFound.Row, BFound.Column).Value = Inp.Range("D7").Value2
Repo.Cells(BFound.Row, BFound.Column + 1).Value = Inp.Range("G7").Value2
Repo.Cells(BFound.Row, BFound.Column + 2).Value = Inp.Range("D9:G10").Value2
For l = 16 To 50
For m = 2 To 4
If m <> 4 And Inp.Cells(l, m) <> "" Then
Result = Result & Trim(Inp.Cells(l, m)) & "-"
Else
Result = Result & Trim(Inp.Cells(l, m))
End If
Next m
If Inp.Cells(l + 1, 2) <> "" Then
Result = Result & vbNewLine
End If
Next l
Repo.Cells(BFound.Row, BFound.Column + 3).Value = Result
Else
UserForm1.Show
If Override = "Y" Then
GoTo AddPgm
Else
MsgBox ("Program not updated in Repository")
End If
End If
End Sub
Revise this Paste