VBA Offseting Active Cell (i) in For/If Staement

Lovelylou79 · Nov 23rd 2017

Hi Forum,

I have the following code that looks for the first non blank cell in Col("I"). Once it finds that cell it completes various Copy/Paste actions, when these are complete I would like to find the next non blank cell, starting 4 rows down rather than in the very next row. I have tried inculding an offset at the end of the if statement which does select the correct cell, however on the Next i it still goes to the next row down instead of the offset row selected. Please help!

Code

Dim LR As Long
Dim i As Integer


Dim Start As Integer


LR = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
numRows = Selection.Rows.Count
numColumns = Selection.Columns.Count


Start = 2


For i = Start To LR
    If Range("I" & i).Value <> "" Then
    Range("A" & i).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).offset(1, 0)
    Range("C" & i).Copy Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).offset(1, 0)
    Range("H" & i).Copy Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).offset(1, 0)
    Range("I" & i).Resize(numRows + 3).Select
    Selection.Copy
    Sheets("Sheet2").Range("E" & Rows.Count).End(xlUp).offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Range("I1").Copy Sheets("Sheet2").Range("D" & Rows.Count).End(xlUp).offset(1, 0)
    Range("B1").Copy Sheets("Sheet2").Range("I" & Rows.Count).End(xlUp).offset(1, 0)
    Range("C1:D1").Copy Sheets("Sheet2").Range("J" & Rows.Count).End(xlUp).offset(1, 0)
    ActiveCell.offset(4, 0).Activate


    Else:
 End If
 Next i

Display More

Currently it only searchs Col("I"). I would also love some assistance in offsetting the column from I to LastColumn, this would include making Range("I1").Copy change to active column.

Thank you in advance for any assistance offered.

**KjBox** · Nov 23rd 2017

For you current code you need to change

Code

ActiveCell.Offset(4, 0).Activate

to

Code

i = i + 3

Note that you add 3 not 4 because the value of i will be increased by 1 as the loop iterates.

If I correctly understand what you mean by "this would include making Range("I1").Copy change to active column." then this should be what you need

Code

Sub test()
    Dim LR As Long, LC As Long, i As Long, ii As Long


    LR = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    LC = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
    numRows = Selection.Rows.Count
    numColumns = Selection.Columns.Count


    For i = 9 To LC
        For ii = 2 To LR
            If Range(ii & i).Value <> "" Then
                Range("A" & i).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                Range("C" & i).Copy Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
                Range("H" & i).Copy Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1, 0)
                Range(ii & i).Resize(numRows + 3).Copy: Sheets("Sheet2").Range("E" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial -4104, , , 1
                Range(ii & "1").Copy Sheets("Sheet2").Range("D" & Rows.Count).End(xlUp).Offset(1, 0)
                Range("B1").Copy Sheets("Sheet2").Range("I" & Rows.Count).End(xlUp).Offset(1, 0)
                Range("C1:D1").Copy Sheets("Sheet2").Range("J" & Rows.Count).End(xlUp).Offset(1, 0)
                i = i + 3
            End If
         Next ii
    Next i


End Sub

Display More

Lovelylou79 · Nov 23rd 2017

i = i + 3 works perfectly!! Thank you so much.
Introducing LC to get it to move columns is along the same lines as I was thinking. I've tried to run it however it bugs out at

Code

If Range(ii & i).Value <> "" Then

I'm trying it on a Mac instead of the Microsoft I have at work, not sure if that has anything to do with it.

Any ideas or alternatives to get that working?

**KjBox** · Nov 23rd 2017

Can you attach a sample workbook please.

Lovelylou79 · Nov 26th 2017

Hi KjBox, Apologies for the late response, I've been away for a long weekend.

Ive been playing with your code again this morning and it still stops at the above line. Spreadsheet attached as requested.

Thanks!

**KjBox** · Nov 26th 2017

Try this

Code

Sub test()
    Dim LR As Long, LC As Long, i As Long, ii As Long


    LR = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    LC = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
    numRows = Selection.Rows.Count
    numColumns = Selection.Columns.Count
    Application.ScreenUpdating = 0


    For i = 9 To LC
        For ii = 2 To LR
            If Cells(ii, i).Value <> "" Then
                Range("A" & i).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                Range("C" & i).Copy Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
                Range("H" & i).Copy Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1, 0)
                Cells(ii, i).Resize(numRows + 3).Copy: Sheets("Sheet2").Range("E" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial -4104, , , True
                Cells(ii, 1).Copy Sheets("Sheet2").Range("D" & Rows.Count).End(xlUp).Offset(1, 0)
                Range("B1").Copy Sheets("Sheet2").Range("I" & Rows.Count).End(xlUp).Offset(1, 0)
                Range("C1:D1").Copy Sheets("Sheet2").Range("J" & Rows.Count).End(xlUp).Offset(1, 0)
                i = i + 3
            End If
         Next ii
    Next i


End Sub

Display More

Lovelylou79 · Nov 28th 2017

Thanks for that.

Back at work and I've managed to make it work.

The final code is:

Code

Sub test8()
'Copy all relevent data from Copy, per mbr
Dim LR As Long, LC As Long
Dim i As Integer, j As Integer


LR = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
LC = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
numRows = Selection.Rows.Count


For ii = 9 To LC
    For i = 3 To LR
        If Cells(i, ii).Value <> "" Then
        Range("A" & i).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).offset(1, 0)
        Range("C" & i).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).offset(0, 1)
        Range("H" & i).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).offset(0, 2)
        Range("H" & i + 1).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).offset(0, 3)
        Cells(i, ii).Resize(numRows + 3).Select
        Selection.Copy
        Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).offset(0, 5).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Cells(2, ii).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).offset(0, 4)
        Range("B1").Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).offset(0, 9)
        Range("C1:D1").Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).offset(0, 10)
        i = i + 3
        Else:
    End If
 Next i
Next ii


End Sub

Display More

Thank you for all your help! Its been very much appreciated.

**KjBox** · Nov 28th 2017

You're welcome

VBA Offseting Active Cell (i) in For/If Staement

Participate now!

Share

Users Viewing This Thread