0
votes

I am trying to write code that would shift the range of cells from the current cell till the last cell that has data in the row one cell to the right if the relative cell that contains the weekday has the values fri or sat.

My code is below, however when it runs, Excel would not respond and restarts by itself. I don't really know where the problem is.

Note: i is the row index, j is the column index

Sub shiftcell()
  Dim i As Integer
  Dim j As Integer
  Dim lcol As Integer
  Dim rng As Range

  For i = 8 To 18
    For j = 6 To 70
      If (Sheets("master").Cells(6, j).Value = "Fri" Or 
      Sheets("master").Cells(6, j).Value = "Sat") Then
        lcol = Sheets("MASTER").Cells(i, Columns.COUNT).End(xlToLeft).Column
        Set rng = Range(Cells(i, j), Cells(i, lcol))
        rng.Cut rng.Cells(i).Offset(0, 1)
      End If
    Next j
  Next i
End Sub
1
You define the range from j to lastcol and then use offset do this instead: After you cut just paste special one cell to the right of your found cell (6,j) as pastespecial (6, j+ 1) this will just paste them all one cell over with that cell as the anchor, keeps from having to be sure the two ranges are equal and avoids that offset.Wookies-Will-Code

1 Answers

0
votes

This should work for you (you can omit the second loop over the rows by selecting the whole range at once, as long as the rows have the same length. Otherwise bring back the row loop but inside the if environement):

Sub shiftcell()
    Dim j, lcol As Long
    Dim rngFrom, rangeTo As Range
    For j = 6 To 70
        If ((Sheets("master").Cells(6, j).Value = "Fri") Or (Sheets("master").Cells(6, j).Value = "Sat")) Then
            lcol = Sheets("master").Cells(8, Columns.Count).End(xlToLeft).Column
            If (lcol >= j) Then
                Set rngFrom = Range(Cells(8, j), Cells(18, lcol))
                Set rngTo = Range(Cells(8, j + 1), Cells(18, lcol + 1))
                rngFrom.Cut rngTo
            End if
        End If
    Next j
End Sub