-3

I hope you are all well and had a great holiday season.

I was wondering if anyone can help me. I would like to know how to add a new variable to the code below that I am using for a holiday request form.

Basically when The user requests the holiday it copies their request to their teams calendar and providing the dates are available then below the dates appears the term "booked"

Currently this is set to 2 people off for all teams but I would like to know how I can enter a variable to alter this fror each team

so that If Team X is entered in Sheet 1 Range A1 allow 2 people off and if Team Y Is entered sheet 1 Range A1 allow 1 person off

Dim Name As String, Team As String, StartRng As String, EndRng As String, ShiftRng As String, Final As String
Dim LastRow As Long
Dim Rng As Range, Rng2 As Range, cRange As Range, Cell As Range

Team = Sheets("Request Form").Range("B11").Value
Name = Team & Replace(Sheets("Request Form").Range("B7").Value, " ", "")
LastRow = Sheets(Team).Cells(Rows.Count, "A").End(xlUp).Row

If Sheets("Request Form").Range("B21").Value = Sheets("Request Form").Range("C21").Value Then

    StartRng = Left(Sheets("Request Form").Range("B21").Value, 2) & Mid(Sheets("Request Form").Range("B21").Value, 4, 2) & Right(Sheets("Request Form").Range("B21").Value, 2)
    If Sheets("Request Form").Range("D21").Value <> "" Then
        ShiftRng = Sheets("Request Form").Range("D21").Value
    Else
        ShiftRng = "Full"
    End If
    Final = Team & StartRng & ShiftRng
    Set Rng = Intersect(Sheets(Team).Range(Name), Sheets(Team).Range(Final))

    If Application.WorksheetFunction.CountA(Sheets(Team).Range(Sheets(Team).Cells(3, Rng.Column), Sheets(Team).Cells(LastRow, Rng.Column))) < 2 Then
        Rng.Interior.ColorIndex = 6
        Rng.Value = "BOOKED"
        Rng.Font.Bold = True
        Else
        Range("DateRequest").Select
        Selection.ClearContents
        MsgBox " Not Booked"
    End If

Else

    StartRng = Left(Sheets("Request Form").Range("B21").Value, 2) & Mid(Sheets("Request Form").Range("B21").Value, 4, 2) & Right(Sheets("Request Form").Range("B21").Value, 2)
    EndRng = Left(Sheets("Request Form").Range("C21").Value, 2) & Mid(Sheets("Request Form").Range("C21").Value, 4, 2) & Right(Sheets("Request Form").Range("C21").Value, 2)
    ShiftRng = "Full"
    Final = Team & StartRng & ShiftRng
    Set Rng = Intersect(Sheets(Team).Range(Name), Sheets(Team).Range(Final))
    Final = Team & EndRng & ShiftRng
    Set Rng2 = Intersect(Sheets(Team).Range(Name), Sheets(Team).Range(Final))
    Set cRange = Sheets(Team).Range(Rng, Rng2)
    For Each Cell In cRange
        If Application.WorksheetFunction.CountA(Sheets(Team).Range(Sheets(Team).Cells(3, Cell.Column), Sheets(Team).Cells(LastRow, Cell.Column))) < 2 Then
            Cell.Interior.ColorIndex = 6
            Cell.Value = "BOOKED"
            Cell.Font.Bold = True
            If (Sheets(Sheets("Request Form").Range("B11").Value).Cells(2, Cell.Column).Text = "AM ") Then
            bookedstring = bookedstring & (Sheets("CS").Cells(1, Cell.Column).Text & " (AM) Booked" & vbCr)
            Else
            If (Sheets(Sheets("Request Form").Range("B11").Value).Cells(2, Cell.Column).Text = "PM") Then
            bookedstring = bookedstring & (Sheets("CS").Cells(1, (Cell.Column - 1)).Text & " (PM) Booked" & vbCr)
            End If
            End If
            Else
        Range("DateRequest").Select
        Selection.ClearContents
        If (Sheets(Sheets("Request Form").Range("B11").Value).Cells(2, Cell.Column).Text = "AM ") Then
            bookedstring = bookedstring & (Sheets("CS").Cells(1, Cell.Column).Text & " (AM) Not Booked" & vbCr)
            Else
            If (Sheets(Sheets("Request Form").Range("B11").Value).Cells(2, Cell.Column).Text = "PM") Then
            bookedstring = bookedstring & (Sheets("CS").Cells(1, (Cell.Column - 1)).Text & " (PM) Not Booked" & vbCr)
            End If
            End If
        End If
    Next Cell
    MsgBox bookedstring

    DateCopy.DateCopy

End If

any help would be greatly appreciated and please ask any questions :)

bloodmilksky
  • 13
  • 1
  • 5
  • I have the rest but I didnt want to confuse things by chucking it all up. do you think it would help? – bloodmilksky Jan 09 '17 at 11:35
  • And code you currently posted is doing what? It collects some information but executes no action. I think from what you posted so far (description and code) current functionality and requested functionality are still unclear. Please [edit] and clarify. (Try impersonate into someone who knows nothing about this.) – miroxlav Jan 09 '17 at 11:43
  • sorry I am really New to this. I have added the rest of the Code. so There’s the bit where it checks to see if the number of cells is less than 2, just instead of using the number 2, I would like to use a variable, and at the start of the Subroutine set the variable to a different value depending on which team the person is in. – bloodmilksky Jan 09 '17 at 11:50
  • If you only have a few teams, declare a variable and use an If statement to set the value depending on the team in cell A1. Then simply replace the 2 with that variable name. If you have many teams, better to set up a table and use a lookup to determine the number. – SJR Jan 09 '17 at 13:14
  • would that be something like Dim "team name" as integer ? – bloodmilksky Jan 09 '17 at 14:42
  • Use 'TeamName' or whatever as can't have spaces `Dim TeamName as Long`. Long is slightly preferable to Integer http://stackoverflow.com/questions/26409117/why-use-integer-instead-of-long – SJR Jan 09 '17 at 14:49
  • sorry SJR am trying to learn as much as I can so I appologise for the Newb Questions – bloodmilksky Jan 09 '17 at 15:01
  • No need to apologise. Post your updated code if problems persist. – SJR Jan 09 '17 at 15:07
  • so ill put Dim CS as Long, Export As Long then below do I determine the value of each team? CS = 2 Export = 1 – bloodmilksky Jan 09 '17 at 15:13
  • I'll post a suggestion below as a bit too big for a comment. – SJR Jan 09 '17 at 15:19

1 Answers1

1

I was thinking of something along these lines. Then replace your hard-coded 2 with TeamName.

Dim TeamName as Long

If sheet1.range("A1")="Team X" then
     TeamName=2
Else
     TeamName=1
End if

Alternative method

Select Case sheet1.range("A1").Value
   case "Team X"
      TeamName=2
   case else
      TeamName=1
 End Select
SJR
  • 22,986
  • 6
  • 18
  • 26
  • can you add as many or as few teams as you want? Thank you so much SJR I really appreciate your help – bloodmilksky Jan 09 '17 at 15:56
  • Yes, though as I said if you have lots you may want to use a table with team names in one column and number in the second, and use a lookup to extract the value in the second column. – SJR Jan 09 '17 at 16:06
  • at the moment at moest I have 6 teams was thinking this would probably be the best way as i have yet to do a lookup function in VB – bloodmilksky Jan 09 '17 at 16:10
  • I have added another formulation above which may be clearer to read with six options. – SJR Jan 09 '17 at 16:13
  • I am just testing the first one you mentioned and it has come up with a compile error. Should I enter it after the variables that have already been defined? – bloodmilksky Jan 09 '17 at 16:16
  • You may need to replace with a sheet name e.g. `If sheets("whatever").range("A1")="Team X" then`. Also there was a typo which I have now corrected above. – SJR Jan 09 '17 at 16:17
  • as Team X is the Only team that can have 2 and the rest can have 1. Instead of defining a specific name can I just enter " " ? – bloodmilksky Jan 09 '17 at 16:37
  • I've updated the code above to take that into account. – SJR Jan 09 '17 at 16:39
  • Done It SJR you are a absolute Legend thank you so much for your help – bloodmilksky Jan 09 '17 at 17:39
  • @bloodmilksky you can accept answer by clicking the check mark on its left if it answers your question – Slai Jan 09 '17 at 21:00