Help creating what I think will be a for/next loop with an if/then statement

excelnovice1111

New Member
Joined
Sep 24, 2015
Messages
8
All,

I have a spreadsheet with three columns, call them add1, add2, and add3. Column add1 always has data in it. Column add2 sometimes has data in it, column add3 also sometimes has data in it. I need to write something that will move (cut/paste) the data from column add3 into add2, but only if there is no data in add2.

I have the following below, which is functional, but since we never know how many rows of data are in the sheet, I don't want to make 500 rows of the same code.

If Cells.Range("B2").Value = "" Then Cells.Range("C2").Cut Destination:=Range("B2")
If Cells.Range("B3").Value = "" Then Cells.Range("C3").Cut Destination:=Range("B3")
If Cells.Range("B4").Value = "" Then Cells.Range("C4").Cut Destination:=Range("B4")
If Cells.Range("B5").Value = "" Then Cells.Range("C5").Cut Destination:=Range("B5")
If Cells.Range("B6").Value = "" Then Cells.Range("C6").Cut Destination:=Range("B6")
If Cells.Range("B7").Value = "" Then Cells.Range("C7").Cut Destination:=Range("B7")
If Cells.Range("B8").Value = "" Then Cells.Range("C8").Cut Destination:=Range("B8")
If Cells.Range("B9").Value = "" Then Cells.Range("C9").Cut Destination:=Range("B9")
If Cells.Range("B10").Value = "" Then Cells.Range("C10").Cut Destination:=Range("B10")

Please help me impress my boss!!!

Thanks!!!
Excelnovice1111
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Something like this

Code:
Sub FillData()
Dim i As Long
Dim LR As Long


LR = Cells.Find("*",SearchOrder:=xlByRows,SearchDirection:=xlPrevious).Row


For i = 2 To LR
    If Cells(i, 2).Value = "" Then Cells(i, 2).Value = Cells(i, 3).Value
Next i
End Sub

or without a loop

Code:
Sub FillData()

Dim LR As Long


LR = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range(Cells(2, 2), Cells(LR, 2)).SpecialCells(xlCellTypeBlanks).Value = Range(Cells(2, 2), Cells(LR, 2)).SpecialCells(xlCellTypeBlanks).Offset(, 1).Value


End Sub
 
Last edited:
Upvote 0
Welcome to the board.

Try running this piece of code:
Code:
Sub FillColB()

Dim x       As Long
Dim arr()   As Variant

    Application.ScreenUpdating = False

    With ActiveSheet

        If .AutoFilterMode Then .AutoFilterMode = False
        
        x = .Range("B" & .rows.Count).End(xlUp).row
        arr = .Range("B1:C" & x).value
        
        For x = LBound(arr, 1) To UBound(arr, 1)
            If IsEmpty(arr(x, 1)) Then arr(x, 1) = arr(x, 2)
        Next x
        
        x = .Range("B" & .rows.Count).End(xlUp).row
        .Range("B1:C" & x).value = arr
        
    End With
    
    Application.ScreenUpdating = True
    
   Erase Arr

End Sub
 
Upvote 0
Welcome to the board.

Try running this piece of code:
Code:
Sub FillColB()

Dim x       As Long
Dim arr()   As Variant

    Application.ScreenUpdating = False

    With ActiveSheet

        If .AutoFilterMode Then .AutoFilterMode = False
        
        x = .Range("B" & .rows.Count).End(xlUp).row
        arr = .Range("B1:C" & x).value
        
        For x = LBound(arr, 1) To UBound(arr, 1)
            If IsEmpty(arr(x, 1)) Then arr(x, 1) = arr(x, 2)
        Next x
        
        x = .Range("B" & .rows.Count).End(xlUp).row
        .Range("B1:C" & x).value = arr
        
    End With
    
    Application.ScreenUpdating = True
    
   Erase Arr

End Sub


Thanks for the help and thanks for the welcome to the board. Both of the examples of code that I received were close, but I still have one issue. The data that is moved was just copied over. I need the data to essentially be cut/pasted over, or deleted from its original location after it is moved. Any help is appreciated!!!
Thanks!!!
Excelnovice1111
 
Upvote 0
Thanks for the help and thanks for the welcome to the board. Both of the examples of code that I received were close, but I still have one issue. The data that is moved was just copied over. I need the data to essentially be cut/pasted over, or deleted from its original location after it is moved. Any help is appreciated!!!
Thanks!!!
Excelnovice1111
 
Upvote 0
Try:
Code:
Sub FillColB()

Dim x       As Long
Dim arr()   As Variant

    Application.ScreenUpdating = False

    With ActiveSheet

        If .AutoFilterMode Then .AutoFilterMode = False
        
        x = .Range("B" & .rows.Count).End(xlUp).row
        arr = .Range("B1:C" & x).value
        
        For x = LBound(arr, 1) To UBound(arr, 1)
            If IsEmpty(arr(x, 1)) Then
                arr(x, 1) = arr(x, 2)
                arr(x, 2) = Null
            End If
        Next x
        
        x = .Range("B" & .rows.Count).End(xlUp).row
        .Range("B1:C" & x).value = arr
        
    End With
    
    Application.ScreenUpdating = True
    
   Erase arr

End Sub
 
Upvote 0
Thanks again for the help. I plugged it in and I still come up with one little problem that I cannot get around. The last row of my data had no contents in column B but had data in column C. It did not move the data in the last row because I am guessing that the macro thought the column had ended at the next to last row since the last row had no data in column B. So it looks like I need a fix to cover situations where there is no data (possibly for several entries) in column B but there still is data in column C.

Thoughts?? :)

Thanks!
Excelnovice1111
 
Upvote 0
Here is what happens to my data at the bottom:

add1add2add3add1add2add3
12xxxxxxx12xxxxxxx
1xxxxxxx1xxxxxxx
12xxxxxxx12xxxxxxx
1xxxxxxx1xxxxxxx
12xxxxxxx12xxxxxxx
1xxxxxxx1xxxxxxx
12xxxxxxx12xxxxxxx
1xxxxxxx1xxxxxxx
12xxxxxxx12xxxxxxx
1xxxxxxx1xxxxxxx
12xxxxxxx12xxxxxxx
1xxxxxxx1xxxxxxx
12xxxxxxx12xxxxxxx
1xxxxxxx1xxxxxxx
12xxxxxxx12xxxxxxx
1xxxxxxx1xxxxxxx
12xxxxxxx12xxxxxxx
1xxxxxxx1xxxxxxx
12xxxxxxx12xxxxxxx
1xxxxxxx1xxxxxxx
1xxxxxxx
1xxxxxxx
12xxxxxxx
1xxxxxxx
1xxxxxxx

<colgroup><col style="width:48pt" span="11" width="64"> </colgroup><tbody>
</tbody>
 
Upvote 0
Ok try:
Code:
Sub FillColB()

Dim x       As Long
Dim arr()   As Variant

    Application.ScreenUpdating = False

    With ActiveSheet

        If .AutoFilterMode Then .AutoFilterMode = False
        
        x = .Range("B" & .rows.Count).End(xlUp).row
        x = Application.Max(x, .Range("C" & .rows.Count).End(xlUp).row)
        
        arr = .Range("B1:C" & x).value
        
        For x = LBound(arr, 1) To UBound(arr, 1)
            If IsEmpty(arr(x, 1)) Then
                arr(x, 1) = arr(x, 2)
                arr(x, 2) = Null
            End If
        Next x
        
        x = .Range("B" & .rows.Count).End(xlUp).row
        .Range("B1:C" & x).value = arr
        
    End With
    
    Application.ScreenUpdating = True
    
   Erase arr

End Sub
 
Upvote 0

Forum statistics

Threads
1,214,805
Messages
6,121,664
Members
449,045
Latest member
Marcus05

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