Search code examples
excelvbaloopsoffset

VBA code that will look for certain criteria and if it matches place data from a different column into a another one


I need help with a VBA code that will look for certain criteria and if it matches place data from a different column into a another one.

If column C says "Circum + spa" and D says "100" then the values in row F need to move over two columns to H until column C says "Circum + spa" and D says "0" (where it will stay in column F.) finished result will looks like a snake.

The code I have started with this process with is:

    Dim l As Long
    With ActiveSheet
        l = .Cells(.Rows.Count, "C").End(xlUp).Row
        For i = 1 To l
            If .Cells(i, "C").Value2 = "CIRCUM + SPA" And 
            .Cells(i, "D") = "100" Then
            .Cells(i + 1, "F").Value = .Cells(i + 1, "H").Value
        Next
    End With

But currently it just makes one row down in column F empty... I have also attempted cut/paste and an offset but all I get are error messages.

I also know that using +1 isn't going to work in final result because I need it to grab everything until the other condition is met.

I have not started on that yet, but would appreciate any advise on a Do-Until loop.

I have attached pictures of what my worksheet looks like now vs what I need it to look like after the macro runs. Also, the rows that move will not always contain 4 cells, sometimes there will be more that's why I need the do until rather than a set range.

before[1] after (2)


Solution

  • Try this

    Sub Demo()
        Dim ws As Worksheet
        Dim cel As Range, fCell As Range, lCell As Range
        Dim lastRow As Long
        Dim flag As Boolean
    
        Set ws = ThisWorkbook.Sheets("Sheet4")      'change Sheet4 to your data sheet
        flag = False
    
        With ws
            lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row    'last row with data in Column C
    
            For Each cel In .Range("C2:C" & lastRow)   'loop through each cell in Column C
                If UCase(cel.Value) = "CIRCUM + SPA" Then   'check if Command Name is "CIRCUM + SPA"
                    If cel.Offset(, 1).Value = 100 Then     'check if SP is 100
                        Set fCell = cel.Offset(1, 0)        'set first cell to be copied in fCell
                        flag = True
                    ElseIf cel.Offset(, 1).Value = 0 Then   'check if SP is 0
                        If flag Then                        'move ahead only if ("CIRCUM + SPA" & 100) already found
                            Set lCell = cel.Offset(-1, 0)   'set last cell to be copied in lCell
                            Set rng = .Range(fCell, lCell).Offset(, 3)  'set range using fCell and lCell
                            rng.Cut rng.Offset(, 2)         'move data from Column F to Column H
                            flag = False
                        End If
                    End If
                End If
            Next cel
        End With
    End Sub
    

    enter image description here