We help IT Professionals succeed at work.

Editing a macro to move particular columns in row

I am looking to edit this macro to not move the entire row but only columns A through M. I have formulas in columns N, O and P and I've attached what occurs once this movedata macro occurs. It erases them.

Sub movedata()

    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim lrow As Long, lr As Long

    Dim rng As Range, cell As Range, r As Range, r2 As Range
    Set ws = Sheets("Current")
    Set ws1 = Sheets("Import")

    lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lr = ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row

    Set rng = ws.Range("A2:A" & lrow)
    Set r = ws1.Range("A2:A" & lr)

    For Each cell In r

        If Application.WorksheetFunction.CountIf(rng, cell.Value) = 0 Then
            lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
            cell.EntireRow.Copy ws.Range("A" & lrow)
        End If
       
    Next cell

 
End Sub

Open in new window

Screen-Shot-2015-04-15-at-9.29.53-AM.png
Comment
Watch Question

Rodney EndrigaData Analyst
Commented:
Change LINE#21 to:

Range(Cells(cell.row, 1), Cells(cell.row, 13)).Copy ws.Range("A" & lrow)

This should only copy the Columns A-M in a specified row.

Author

Commented:
For the below code when it compares the two sheets and copies over any new rows, I want it to only copy over columns A through M in the 'Current' tab. I think it is taking the whole row from the 'Import' tab.

Sub compare()
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim lrow As Long, lr As Long
    Dim lcol As Long
    Dim z As Long
    Dim rng As Range, cell As Range, r As Range, r2 As Range
    Set ws = Sheets("Current")
    Set ws1 = Sheets("Import")
    lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lr = ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    lcol = ws.Cells(1, Cells.Columns.Count).End(xlToLeft).Column

    Set rng = ws.Range("A2:A" & lrow)
    Set r = ws1.Range("A2:A" & lrow)
If lrow > 1 Then
    For Each cell In rng
        If Application.WorksheetFunction.CountIf(r, cell.Value) = 1 Then

            Set r2 = r.Find(What:=cell.Value, After:=ws1.Range("A2"), SearchOrder:=xlByRows, SearchDirection:=xlNext)
            z = 2
            Do Until z > lcol

                If cell.Offset(0, z - 1).Value <> ws1.Cells(r2.Row, z) Then
                    cell.Offset(0, z - 1).Value = ws1.Cells(r2.Row, z)
                    cell.Offset(0, z - 1).Interior.ColorIndex = 3
                End If
                z = z + 1
            Loop

        End If

    Next cell
End If
    movedata

End Sub

Open in new window

Data Analyst
Commented:
Hi AckeemK,

If Columns N,O,P are the last columns in your dataset, you can change LINE#12 to:

lcol = ws.Cells(1, Cells.Columns.Count).End(xlToLeft).Column - 3

Open in new window

If you have other Columns of data past N,O,P, you will have to re-code.

Please advise.

However, the MOVEDATA procedure seems to be COPYING the information from one sheet to another sheet. So my 1st suggestion should only bring the Columns A-M to the proper sheet.