Offset after loop

[horizonflame]

Hi All

I would like to copy all non-blank cells in range R5:X7000 into the adjacent cell in Range K5:Q7000 as paste values. Essentially any non-blank cells will paste as a value in same row but 7 columns to the left. I have what I think is a good piece of code but need some help how to edit it to my cell range and paste area.

Sub CopyData()    Application.ScreenUpdating = False
    Dim c As Range
    For Each c In Range("K5:Q7000")
        If c.Offset(0, 1) <> "" Then     NEED TO CHANGE THIS LINE
            c.Copy
            Cells(Rows.Count, "H").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)   NEED TO CHANGE THIS LINE
            Application.CutCopyMode = False
        End If
    Next c
    Application.ScreenUpdating = False
End Sub

Many thanks

 

[igold]

Re: Help with Offset after loop

I am a little confused with exactly how you want to deal with the non blank cells. if a cell is blank and you want it to go away then any cells to the right of the blank are going to move more than 7 rows to the left depending on how many blanks there are in that row. That said, does this get you any closer to what you want.

Sub moveValues()


    Dim c As Long, r As Long, c1 As Long, r1 As Long
    Dim arr, noblk(1 To 6996, 1 To 7)
    
    arr = Range("R5:X7000")
    c1 = 1: r1 = 1
    For c = 1 To 6996
        For r = 1 To 7
            If Not arr(c, r) = Empty Then
                noblk(c1, r1) = arr(c, r)
                r1 = r1 + 1
            End If
        Next
        c1 = c1 + 1
        r1 = 1
    Next
    Range("K5").Resize(UBound(noblk, 1), UBound(noblk, 2)) = noblk


End Sub

 

[horizonflame]

Re: Help with Offset after loop

Apologies, let me explain in more detail in case that helps a better solution.

With Column R I want to copy any Rows that contain dates into the adjacent Column K and paste as values. And repeat with Column S into column L etc for all 7 columns. The range contains either dates or blank cells.

I thought offset was the right thing to try but I don’t quite understand how that works yet.

Many thanks

 

[Akuini]

Re: Help with Offset after loop

Try:

  Range("R5:X7000").Copy
  Range("K5").PasteSpecial Paste:=xlPasteValues, [COLOR=#0000cd]SkipBlanks:=True[/COLOR]

 

[horizonflame]

Re: Help with Offset after loop

That’s brilliantly simple, thank you!

 

[Akuini]

Re: Help with Offset after loop

You're welcome, glad to help, & thanks for the feedback.

 

[horizonflame]

Re: Help with Offset after loop

Hey @Akuini, apologies but I've found it will copy all cells in the range. It may be because they are not truely blank but have a formula that returns a "" result. Could that be tweaked at all?

Thanks

 

[igold]

Re: Help with Offset after loop

Can you show a small sample of the before and after that you expect....

Do you want the cells that contain formulas to be copied back as blank cells with no formula. If that is the case, how about this...

Sub moveValues()


    Dim arr
    
    arr = Range("R5:X7000")
    Range("K5").Resize(UBound(arr, 1), UBound(arr, 2)) = arr


End Sub

 

[horizonflame]

Re: Help with Offset after loop

[TABLE="width: 500"]
<tbody>[TR]
[TD] Column R[/TD]
[TD]Original Column K[/TD]
[TD]New Column K[/TD]
[/TR]
[TR]
[TD]24/10/2019[/TD]
[TD][/TD]
[TD]24/10/2019[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]20/10/2019[/TD]
[TD]20/10/2019[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]21/10/2019[/TD]
[TD]21/10/2019[/TD]
[/TR]
[TR]
[TD]26/10/2019[/TD]
[TD][/TD]
[TD]26/10/2019[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]25/10/2019
[/TD]
[TD]25/10/2019[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]28/10/2019[/TD]
[TD][/TD]
[TD]28/10/2019[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]30/10/2019[/TD]
[TD]30/10/2019[/TD]
[/TR]
</tbody>[/TABLE]


Hi @igold, i have done an example column with expected result above. I am looking for Columns R:X to go into K:Q and combine with the existing data, I don't want to overwrite the existing data. The blanks are "" formula results so I want to ignore them to avoid the overwriting.

Thanks again

 

[igold]

Re: Help with Offset after loop

Does this do what you want...

Sub movevalues2()

    Dim rngRx As Range, rngKQ As Range
    Dim i As Long
    
    Set rngRx = Range("R5:X7000")
    Set rngKQ = Range("K5:Q7000")
    For i = 1 To 6996
        If Not rngRx.Cells(i) = "" And rngKQ.Cells(i) = "" Then
            rngKQ.Cells(i) = rngRx.Cells(i)
        End If
    Next
    
End Sub