Shifting data based on values

Are you wanting EACH row to be evaluated individually? or if B3 = and C3 < 0 then shift everything, the ENTIRE dataset to the right?


This evaluate and will shift each row individually:
macro help With Code.xlsm

Code with comments so you can understand what I am doing and why:

Option Explicit

Sub ProcessMyData()

'===================================================================
'Declare Variables
'===================================================================
    Dim DataSheet As String 'Used to define DataSource sheet
    Dim LastRow As Long 'Used to determine last row with data
    Dim StartRow As Long ' Used to detemine first row to start at
    Dim I As Long 'Used to loop through rows

'===================================================================
'Define Variables
'===================================================================
    StartRow = 5 ' this is the row where you want to BEGIN your work
    DataSheet = ThisWorkbook.ActiveSheet.Name 'Defines the Data Sheet Name
    LastRow = Worksheets(DataSheet).Cells(Rows.Count, 1).End(xlUp).Row 'This will find the last used row in column A of Data sheet

'===================================================================
'Setup for speed
'===================================================================
    Application.ScreenUpdating = False 'Sets ScreenUpdating Off
    Application.Calculation = xlCalculationManual 'Sets calculations to manual so it wont calc during procedute

'===================================================================
'Process Data
'===================================================================
    
 For I = StartRow To LastRow 'This loops through each of the rows
 Application.StatusBar = "Processing Row: " & I & " of " & LastRow 'this just has a neat little indicator on the statusbar
    
    If Range("B" & I).Value = 0 And Range("C" & I).Value > 0 Then 'This checks for Bi and Ci like you asked for
        
        Range("B" & I & ":J" & I).Value = Range("C" & I & ":K" & I).Value
            Range("K" & I).ClearContents
        Range("M" & I & ":U" & I).Value = Range("N" & I & ":V" & I).Value
            Range("V" & I).ClearContents
        Range("X" & I & ":AF" & I).Value = Range("Y" & I & ":AG" & I).Value
            Range("AG" & I).ClearContents
        Range("AI" & I & ":AQ" & I).Value = Range("AJ" & I & ":AR" & I).Value
            Range("AR" & I).ClearContents
            
    End If
Next I
    
    ThisWorkbook.Worksheets(DataSheet).Range("A1").Select 'Just selects a random cell to tidy things up at the end
    
'===================================================================
'End Macro Procedures
'===================================================================
    Application.CutCopyMode = False
    Application.ScreenUpdating = True 'Turns screen updating back on
    Application.Calculation = xlCalculationAutomatic 'Turns calculations back on
    Application.StatusBar = False
    MsgBox "Process Complete" 'Gives the user a message

End Sub

@MikeTron: Yes, each row should be evaluated individually. Thanks everyone, I'll try these out.

This does that:

Option Explicit

Sub ShiftLeft()
Dim LR As Long, Rw As Long, COL As Long

LR = Range("A" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False
For Rw = 3 To LR
    If Range("B" & Rw).Value = 0 And Range("C" & Rw).Value > 0 Then
        For COL = 3 To 36 Step 11
            With Cells(Rw, COL).Resize(, 9)
                .Offset(, -1).Value = .Value
            End With
            Cells(Rw, COL + 8).ClearContents
        Next COL
    End If
Next Rw
Application.ScreenUpdating = True

End Sub

Here's my attempt:

Option Explicit
Sub Macro1()

    Const lngStartRow As Long = 3 'Starting row number for the data. Change to suit.
    
    Dim lngLastRow As Long, _
        lngMyRow As Long
    
    lngLastRow = Range("B:C").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    Application.ScreenUpdating = False
    
    For lngMyRow = lngStartRow To lngLastRow
        If Val(Range("B" & lngMyRow)) = 0 And Val(Range("C" & lngMyRow)) > 0 Then
            Range("B" & lngMyRow & ":J" & lngMyRow).Value = Range("C" & lngMyRow & ":K" & lngMyRow).Value
            Range("K" & lngMyRow).ClearContents
            Range("M" & lngMyRow & ":U" & lngMyRow).Value = Range("N" & lngMyRow & ":V" & lngMyRow).Value
            Range("V" & lngMyRow).ClearContents
            Range("X" & lngMyRow & ":AF" & lngMyRow).Value = Range("Y" & lngMyRow & ":AG" & lngMyRow).Value
            Range("AG" & lngMyRow).ClearContents
            Range("AI" & lngMyRow & ":AQ" & lngMyRow).Value = Range("AJ" & lngMyRow & ":AR" & lngMyRow).Value
            Range("AR" & lngMyRow).ClearContents
        End If
    Next lngMyRow
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert

Correction to my code for putting 0 in year 10.

Option Explicit

Sub ShiftLeft()
Dim LR As Long, Rw As Long, COL As Long

LR = Range("A" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False
For Rw = 3 To LR
    If Range("B" & Rw).Value = 0 And Range("C" & Rw).Value > 0 Then
        For COL = 3 To 36 Step 11
            With Cells(Rw, COL).Resize(, 9)
                .Offset(, -1).Value = .Value
            End With
            Cells(Rw, COL + 8).Value = 0
        Next COL
    End If
Next Rw
Application.ScreenUpdating = True

End Sub

Option Explicit

Sub ShiftLeft()
Dim LR As Long, Rw As Long, COL As Long

LR = Range("A" & Rows.Count).End(xlUp).Row      'find the last row of data

Application.ScreenUpdating = False              'speed up macro

For Rw = 3 To LR                                'loop through one row at a time
    If Range("B" & Rw).Value = 0 And Range("C" & Rw).Value > 0 Then
        For COL = 3 To 36 Step 11               'process column groups of 11 starting at C
            With Cells(Rw, COL).Resize(, 9)     'copy 9 cells...
                .Offset(, -1).Value = .Value    '...to the left one cell
            End With
            Cells(Rw, COL + 8).Value = 0        'set the 10th cell to 0
        Next COL                                'next column group of 11
    End If
Next Rw
Application.ScreenUpdating = True               'update the screen, back to normal

End Sub

Trebor's LR construct is fundamentally better as it looks for the "last used row" in several columns.

Me, I prefer to select one key most important column, invariably column A, and just look UP that one column.

The "." connects the commands to follow to the original WITH parent. Instead of having to identify parents over and over, then issue commands:

Sheets("Sheet1").Range("A:A").ClearContents
Sheets("Sheet1").Rows(1).Copy Sheets("Sheet1").Range("A7")

...you can set a parent object once... makes editing easier:

With Sheets("Sheet1")
    .Range("A:A").ClearContents
    .Rows(1).Copy .Range("A7")
End With

Hi ammartino44,

Here's my code commented:

Option Explicit 'Forces variable declaration at run time. Without it, any undeclared variables will be assigned as variants - the most expensive (in terms of memory) type of variable.
Sub Macro1()

    'Declare constant variable.  As these types of variables are usually static they provide a good starting reference
    Const lngStartRow As Long = 3 'Starting row number for the data. Change to suit.
    
    'Declare dynamic variables
    Dim lngLastRow As Long, _
        lngMyRow As Long
    
    'Finds the last row from columns B and C
    lngLastRow = Range("B:C").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    'Turn screen updating off
    Application.ScreenUpdating = False
    
    'Loop through each row in the defined number of rows
    For lngMyRow = lngStartRow To lngLastRow
        'If Col. B of the 'lngMyRow' row equals zero and Col. C is greater than zero, then...
        If Val(Range("B" & lngMyRow)) = 0 And Val(Range("C" & lngMyRow)) > 0 Then
            '...make the values across Col's B to J the same as Col's C to K, and...
            Range("B" & lngMyRow & ":J" & lngMyRow).Value = Range("C" & lngMyRow & ":K" & lngMyRow).Value
            '...clear the contents in Col. K, and...
            Range("K" & lngMyRow).ClearContents
            '...make the values across Col's M to U the same as Col's N to V, and...
            Range("M" & lngMyRow & ":U" & lngMyRow).Value = Range("N" & lngMyRow & ":V" & lngMyRow).Value
            '...clear the contents in Col. V, and...
            Range("V" & lngMyRow).ClearContents
            '...make the values across Col's X to AF the same as Col's Y to AG, and...
            Range("X" & lngMyRow & ":AF" & lngMyRow).Value = Range("Y" & lngMyRow & ":AG" & lngMyRow).Value
            '...clear the contents in Col. AG, and...
            Range("AG" & lngMyRow).ClearContents
            '...make the values across Col's AI to AQ the same as Col's AJ to AR, and...
            Range("AI" & lngMyRow & ":AQ" & lngMyRow).Value = Range("AJ" & lngMyRow & ":AR" & lngMyRow).Value
            '...clear the contents in Col. AR
            Range("AR" & lngMyRow).ClearContents
        End If
    Next lngMyRow
    
    'Turn screen updating back on
    Application.ScreenUpdating = True

End Sub

HTH

Robert