SOLVED

VBA to move cell values to a cell address in each row of a table

Occasional Contributor

Hi,

I have a list on sheet "New Template" of values in range L9:L32 (New Date) with cell addresses (eg, $D$14) in the next column range M9:M32 (Cell Ref) that I need the values coping to on a sheet called "Dates".

I want to write a macro that loops through the list and moves the each date, then clears data in "New Template".

 

I have tried this but it doesn't work at all:

 

Sub Test1()
Dim lRow As Integer
Dim i As Integer

lRow = Cells(Rows.Count, 9).End(xlUp).Row

For i = 9 To lRow

If (Cells(i, 12) = "") Then

Else

Cells(i, 12).Copy
CellAdd = Cells(i, 13).Value
Sheets("Dates").Range.CellAdd.PasteSpecial Paste:=xlPasteValues

End If
Next i

On Error GoTo 0

End Sub

 

Any help would be appreciated, even if it is to be told its not possible!!

11 Replies

@Lindsy 

Change

Sheets("Dates").Range.CellAdd.PasteSpecial Paste:=xlPasteValues

to

Sheets("Dates").Range(CellAdd).PasteSpecial Paste:=xlPasteValues

@Lindsy 

A slightly different version:

Sub MoveDates()
    Dim ws As Worksheet
    Dim wt As Worksheet
    Dim s As Long
    Dim m As Long
    Application.ScreenUpdating = False
    Set ws = Worksheets("New Template")
    Set wt = Worksheets("Dates")
    m = ws.Range("L" & ws.Rows.Count).End(xlUp).Row
    For s = 9 To m
        If ws.Range("L" & s).Value <> "" Then
            wt.Range(ws.Range("M" & s).Value).Value = ws.Range("L" & s).Value
        End If
    Next s
    ws.Range("L9:L" & m).ClearContents
    Application.ScreenUpdating = True
End Sub

Thank you, just saw your reworked version

@Hans Vogelaar

Thank you so much, I ran this and got a Type 13 mismatch :

  If ws.Range("L" & s).Value <> "" Then

@Lindsy 

Does column L contain error values?

No, just dates or blank.
Just a note, column M are formula that returns the cell address, would that be causing an issue?

@Lindsy 

No, that shouldn't be a problem.

Could you attach a sample workbook (without sensitive data), or if that is not possible, make it available through OneDrive, Google Drive, Dropbox or similar? Alternatively, you can attach it to a private message to me. Thanks in advance.

Hi, I have sent you a private message. Thank you so much!!
best response confirmed by Lindsy (Occasional Contributor)
Solution

@Lindsy 

Thanks. The cause of the problem was that there are other data below the update table.

This version should work:

Sub MoveDates()
    Dim ws As Worksheet
    Dim wt As Worksheet
    Dim s As Long
    Dim m As Long
    Application.ScreenUpdating = False
    Set ws = Worksheets("New Template")
    Set wt = Worksheets("Dates")
    m = ws.Range("L31").End(xlUp).Row
    For s = 9 To m
        wt.Range(ws.Range("M" & s).Value).Value = ws.Range("L" & s).Value
    Next s
    ws.Range("L9:L" & m).ClearContents
    Application.ScreenUpdating = True
End Sub
And the last error is my address formula. Thank you so much for your help, that's amazing!!!