More complex VBA

[samfuge]

Hi all,

I am a VBA novice and this task is a little past what I know right now. I am working to refine a scheduling spreadsheet I am using for work. I have an example below. I need a VBA to format the schedule as shown in rows 6 and 7. As of now, the values in rows 3 and 4 are how they appear when the schedule is complete. Essentially, I need the values moved to a separate line based on the value (carriage return added). If "00:00 - 08:00" is present, then it should be at the top of the cell. "08:00 - 16:00" should be in the center of the cell. "16:00 - 24:00" should be at the bottom of the cell." Therefore if a person is scheduled 0000-0800 and 1600-2400, then it should have the first shift at the top, a blank line in the middle of the cell, and the 1600 shift listed at the bottom of the cell.
The range of the cells needing this formatting is C3:I46
Thanks in advance, all.

 

[maabadi]

Welcome to MrExcel Message Board.
Please Upload Your Example file & Desired Result with XL2BB ADDIN (Preferable) or Upload At Free Hosting Site e.g. GoogleDrive, OneDrive or www.dropbox.com , ... & Insert Link here to we now what is your data format and Structure.

 

[kanadaaa]

Some clarifications needed:
1. How do you type in schedule hours? Do you use a userform?
2. Do you have multiple worksheets, corresponding to each week? Or do you have separate workbooks for different weeks?

 

[SamDsouza]

Hi SamFuge

Welcome to the Forum

If you are not Familiar with VBA
Go into Developer TAB Click on Visual Basic then Double Click on sheet1 or your Defined Sheet
You will See Dropdown with General
Select Worksheet which is Below General
By default you will get Worksheet_SelectionChange(ByVal Target As Range)
Leave the above as is and Select Worksheet_Change and Paste Below Code

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, cCell As Range

Set rng = Worksheets("Sheet1").Range("C3:I46")

For Each cCell In rng
If cCell.Text = "00.00-08.00" Then cCell.VerticalAlignment = xlTop
If cCell.Text = "08.00-16.00" Then cCell.VerticalAlignment = xlCenter
If cCell.Text = "16.00-24.00" Then cCell.VerticalAlignment = xlBottom
cCell.RowHeight = 45
Next

End Sub

Note : All your cells in the Worksheet its Rowheight shall be 45
SamD
197

 

[maabadi]

Also you Can Try this Code:

Sub CustomFormats1()
Dim i As Long, J As Long, K As Long, S As String, Lr As Long, Cell As Range
Lr = Range("A" & Rows.Count).End(xlUp).Row
Rows("3:" & Lr).RowHeight = 45
For Each Cell In Range("C3:I" & Lr)
If Cell.Value = "" Then GoTo NC
S = Trim(Left(Cell.Value, Application.WorksheetFunction.Find(":", Cell.Value) - 1))
K = CLng(S)
Select Case K
Case 0
Case 8
Cell.Value = vbLf & Cell.Value
Case 16
Cell.Value = vbLf & vbLf & Cell.Value
End Select
Cell.WrapText = True
NC:
Next Cell
End Sub

 

[kanadaaa]

I think it's best to make a userform like this:

And regulate it with the codes below:
[Standard Module]

Sub ShowInsertSchedule()
    InsertSchedule.Show
End Sub

[Form Module]

Private Sub UserForm_Initialize()
    Dim lr As Long, i As Long, j As Long
    
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    If lr >= 3 Then
        For i = 3 To lr
            If Cells(i, "A") <> "" Then
                ComboBox1.AddItem Cells(i, "A").Value
            End If
        Next i
    End If
    
    j = 3
    For i = 2 To 14 Step 2
        Me.Controls("Label" & i).Caption = Cells(2, j)
        j = j + 1
    Next i
    
    For i = 1 To 21
        Me.Controls("CheckBox" & i).Value = False
    Next i
    
End Sub

Private Sub CommandButton1_Click()
    Dim lr As Long, fnd As Range, msg As Long, i As Long, filled As Boolean, schedules(1 To 21) As String, j As Long
    
    'Check if employee is selected
    If ComboBox1 = "" Then
        MsgBox "Employee not specified.", vbExclamation, "Error"
        Exit Sub
    End If
    
    'Check if employee exists and get the number of the row into which to insert schedule
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    Set fnd = Range(Cells(3, "A"), Cells(lr, "A")).Find(ComboBox1, , xlValues, xlWhole)
    If fnd Is Nothing Then
        msg = MsgBox("Employee not found. Would you like to insert the schedule to a new row? (Press Yes to proceed, No to go back to the form, or Cancel to close the form.)", _
                    vbExclamation + vbYesNoCancel, "Employee Not Found")
        If msg = vbYes Then
            Set fnd = Cells(lr + 1, "A")
        ElseIf msg = vbNo Then
            Exit Sub
        ElseIf msg = vbCancel Then
            Unload Me
            Exit Sub
        End If
    End If
    
    'Check if the employee's schedule is already filled in
    For i = 2 To 8
        If fnd.Offset(, i) <> "" Then
            filled = True
            Exit For
        End If
    Next i
    If filled Then
        msg = MsgBox("The schedule for the employee already exists. Would you like to overwrite? (Press Yes to proceed, No to go back to the form, or Cancel to close the form.)", _
                    vbInformation + vbYesNoCancel, "Schedule Already Exists")
        If msg = vbYes Then
            'Do nothing and proceed
        ElseIf msg = vbNo Then
            Exit Sub
        ElseIf msg = vbCancel Then
            Unload Me
            Exit Sub
        End If
    End If
    
    'Output schedule
    '(Get schedule)
    For i = 1 To 21
        If Me.Controls("CheckBox" & i).Value = True Then
            schedules(i) = Me.Controls("CheckBox" & i).Caption
        Else
            schedules(i) = ""
        End If
    Next i
    
    '(Output)
    j = 1
    Application.ScreenUpdating = False
    For i = 2 To 8
        fnd.Offset(, i) = schedules(j) & vbCrLf & schedules(j + 1) & vbCrLf & schedules(j + 2)
        j = j + 3
    Next i
    Application.ScreenUpdating = True
    
    'End message
    Unload Me
    fnd.Resize(, 9).Select
    MsgBox "Done.", , "Done"
    
End Sub

Private Sub CommandButton2_Click()
    Dim ctrl As Control
    For Each ctrl In Me.Controls
        If TypeOf ctrl Is msforms.CheckBox Then
            ctrl.Value = False
        ElseIf TypeOf ctrl Is msforms.ComboBox Then
            ctrl.Value = ""
        End If
    Next ctrl
End Sub

Private Sub CommandButton3_Click()
    Unload Me
End Sub

Sample workbook: https://easyupload.io/ocdtyb

 

[samfuge]

Some clarifications needed:
1. How do you type in schedule hours? Do you use a userform?
2. Do you have multiple worksheets, corresponding to each week? Or do you have separate workbooks for different weeks?

I have multiple sheets, but I have a macro that posts the values from a "Payroll" sheet that has all employees (scheduled and not scheduled) to this sheet with just the employees who are scheduled; therefore the info in each cell is just text, not formulas.

 

[mikerickson]

Rather that one row and cells with linebreaks, have you thought about a whole row for each shift?