VBA- Every other cell in row

menschmaschine

New Member
Joined
Dec 21, 2022
Messages
9
Office Version
  1. 365
Platform
  1. Windows
Can anyone tell me what I'm doing wrong here?

This is for a work scheduling sheet. Column A has "Shift 1", "Shift 2", and "Shift 3" in that order for various "Locations" down the sheet. So there may be 10 or so sets of "Shift 1", "Shift 2", and "Shift 3", with a variable number of rows in between (for the employees in those shifts). Column B has a Location Name, "Employee" header, and a list of employees at each location and for each shift. Then columns D through AE (4 through 31) have start and end times for each day in a 14-day period (so, 28 columns). The issue I'm trying to resolve is that there are some people that work 2 different shifts for a given location. But their start and end times for both shifts show up in both shifts. So, if someone worked Shift 1 and 2, I'm trying to get their Shift 2 times out of Shift 1 and vice versa. There are also employees that are off on a given day with no times in the cells, but the cells for those off days have a string that contains a ".", hence the InStr code below... it's just a way to leave the non-time cells alone.

So, I'm trying to get the code to look through the start times of the 14-day period (every other column, so... 4, 6, 8, 10, etc.) and, only for cells with time values, clear the contents of any start times (and its associated end time cell to the right) that don't meet the value criteria for that shift. I've tried this a number of ways, and below is my last attempt that I thought was close. But I'm getting a Type Mismatch error in the second shift code (don't know why it doesn't error in the 1st shift, but that isn't working either).
VBA Code:
Sub TimeCleanup_Test()
Dim USch As Worksheet, ELRow As Long, UTim As Range, UTimCel As Range
Dim ShCol As Range, ShCel As Range, ShLRow As Long, Sh1FRow As Long, Sh1LRow As Long, Sh2FRow As Long, Sh2LRow As Long, Sh3FRow As Long, Sh3LRow As Long
Dim UTim1 As Range, UTim1Cel As Range, UTim2 As Range, UTim2Cel As Range, UTim3 As Range, UTim3Cel As Range
Dim i As Integer

Application.ScreenUpdating = False

Set USch = Sheets("Unit Schedule")
ELRow = USch.Range("B" & Rows.Count).End(xlUp).Row

With USch

ShLRow = USch.Range("A" & Rows.Count).End(xlUp).Row
Set ShCol = USch.Range("A13:A" & ShLRow)

For Each ShCel In ShCol
    If ShCel.value = "Shift 1" Then
        Sh1FRow = ShCel.Offset(1, 0).Row
        ElseIf ShCel.value = "Shift 2" Then
            Sh1LRow = ShCel.Offset(-1, 0).Row
            Sh2FRow = ShCel.Offset(1, 0).Row
            ElseIf ShCel.value = "Shift 3" Then
                Sh2LRow = ShCel.Offset(-1, 0).Row
                Sh3FRow = ShCel.Offset(1, 0).Row
                ElseIf ShCel.value = "^" Then
                    Sh3LRow = ShCel.Offset(-1, 0).Row
                    Set UTim1 = Range(Cells(Sh1FRow, 4), Cells(Sh1LRow, 31))
                    Set UTim2 = Range(Cells(Sh2FRow, 4), Cells(Sh2LRow, 31))
                    Set UTim3 = Range(Cells(Sh3FRow, 4), Cells(Sh3LRow, 31))
                    
                    For i = 4 To 30 Step 2
                        Set UTim1 = UTim1.Columns(i)
                        For Each UTim1Cel In UTim1
                            If InStr(1, UTim1Cel.value, ".") = 0 Then
                                If UTim1Cel.value < 0.125 Or UTim1Cel.value > 0.457639 Then
                                    UTim1Cel.ClearContents
                                    UTim1Cel.Offset(0, 1).ClearContents
                                End If
                            End If
                        Next UTim1Cel
                    
                        Set UTim2 = UTim2.Columns(i)
                        For Each UTim2Cel In UTim2
                            If InStr(1, UTim2Cel.value, ".") = 0 Then
                                If UTim2Cel.value < 0.458333 Or UTim2Cel.value > 0.791667 Then
                                    UTim2Cel.ClearContents
                                    UTim2Cel.Offset(0, 1).ClearContents
                                End If
                            End If
                        Next UTim2Cel
                    
                        Set UTim3 = UTim3.Columns(i)
                        For Each UTim3Cel In UTim3
                            If InStr(1, UTim3Cel.value, ".") = 0 Then
                                If UTim3Cel.value > 0.124306 And UTim3Cel.value < 0.792361 Then
                                    UTim3Cel.ClearContents
                                    UTim3Cel.Offset(0, 1).ClearContents
                                End If
                            End If
                        Next UTim3Cel
                    Next i
    End If
Next ShCel

End With

Application.ScreenUpdating = True
End Sub
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Several issues:
1. Here, you are already defining your range from column 4 to 31 at this point:
VBA Code:
Set UTim1 = Range(Cells(Sh1FRow, 4), Cells(Sh1LRow, 31))
So column D becomes the 1st column of Utim1 range.
Starting from 4th column of Utim1 means you are looping through actual column H :)
For i = 4 To 30 Step 2 must be For i = 1 To 26 Step 2 in my opininon.

2. But you can't loop through :) Because referring to a column is not enough to loop through its cells. You have to specify the column property you want to loop through. In this case, they are Cells. Set UTim1Col = UTim1.Columns(i).Cells

3. Yes, and please don't set the same range name to set another range. It may be impossible to access it again. Use more variables, it won't hurt if you don't have gigabytes of data. Set UTim1 = UTim1.Columns(i).Cells If you use like this, you won't be able to access the other columns of UTim1 in the future. Because it becomes a single-column range. It would be better to use like this:
VBA Code:
Set UTim1Col = UTim1.Columns(i).Cells
 For Each UTim1Cel In UTim1Col

4. This is not causing a problem in your code but please get the habit to use .Value2 with dates and times. Generally, .Value is the visible value in the cell that we see which is formatted (Like 2:30 or 1.1.2023). But .Value2 is the real numeric value (Like 1.10417 or44927) and is safer to use for comparisons and other operations.

I hope all these make sense and help with your problem (y)
 
Last edited by a moderator:
Upvote 0
Solution
Thanks a lot, Flashbond. I did everything you said and it worked... mostly... for some reason the If InStr looking for the "." in each cell didn't work. It didn't error out; it just didn't work... nothing happened. So, I removed the If InStr and their End Ifs and then it worked. But it took out all the non-time cells, too. So, I changed the "." to a "(", which is another common character to the non-time cells, and it worked. Don't know why it didn't work with the "." (because that worked elsewhere in a different sub for this same sheet), but I can't complain because it works now. Thanks again!
 
Upvote 0
I can't test it now, but maybe it sees the "." as decimal point. I know, one is number and the other is string... As I told you, I can't test it now. A possible workaround could be:
VBA Code:
If IsNumeric(UTim1Cel.Value) Then
 
Upvote 0
Ah... IsNumeric. That's even better. I'd rather do that than rely on a specific character. Tried it and it works perfectly. Thanks again.
 
Upvote 0

Forum statistics

Threads
1,214,834
Messages
6,121,876
Members
449,056
Latest member
ruhulaminappu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top