Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Solved

Copy rows based on value in cell to first available empty row.

Posted on 2012-03-15
4
296 Views
Last Modified: 2012-03-15
I have a spreadsheet with Columns A thru L.  I need to copy rows if the value in Column C is equal to Brown into the first empty cells at the end of the spreadsheet.
0
Comment
Question by:mato01
  • 2
  • 2
4 Comments
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 37727454
You can try this. You will have to assign appropriate sheet names to sws and tws
0
 
LVL 42

Expert Comment

by:dlmille
ID: 37727504
If you want to copy those rows to the bottom of the existing sheet, use the first sub copyRows().  Otherwise, if you want a new worksheet created and the rows with A:L data and C column is blank, then use the sub copyRowsNewWorksheet()

The app works on the active sheet of the active workbook.  Finds cells with blanks in column c then copys that row range A:L to the bottom of the worksheet, or appends to a new sheet, depending on routine selected.

Option Explicit

Sub copyRows()
Dim wkb As Workbook
Dim wks As Worksheet
Dim r As Range
Dim rng As Range
Dim lastRow As Long
Dim i As Long

    Application.ScreenUpdating = False
    
    Set wkb = ActiveWorkbook
    Set wks = wkb.ActiveSheet
    
    lastRow = wks.Range("A" & wks.Rows.Count).End(xlUp).Row
    Set rng = wks.Range("C1:C" & lastRow)
    For Each r In rng.SpecialCells(xlCellTypeBlanks)
        wks.Range("A" & r.Row & ":L" & r.Row).Copy 'copy A:L on blank cell column C to bottom of existing worksheet
        wks.Range("A" & lastRow + i + 1).PasteSpecial
        Application.CutCopyMode = False
        i = i + 1

    Next r
        
    MsgBox "Process Complete"
    
    Application.ScreenUpdating = True
End Sub
Sub copyRowsNewWorksheet()
Dim wkb As Workbook
Dim wks As Worksheet
Dim wksOut As Worksheet
Dim r As Range
Dim rng As Range
Dim lastRow As Long
Dim i As Long

    Application.ScreenUpdating = False
    
    Set wkb = ActiveWorkbook
    Set wks = wkb.ActiveSheet
    Set wksOut = wkb.Worksheets.Add(after:=wkb.Worksheets(wks.Name))
    
    lastRow = wks.Range("A" & wks.Rows.Count).End(xlUp).Row
    Set rng = wks.Range("C1:C" & lastRow)
    For Each r In rng.SpecialCells(xlCellTypeBlanks)
        wks.Range("A" & r.Row & ":L" & r.Row).Copy 'copy A:L on blank cell column C to bottom of existing worksheet
        wksOut.Range("A" & i + 1).PasteSpecial
        Application.CutCopyMode = False
        i = i + 1
    Next r
        
    MsgBox "Process Complete"
    
    Application.ScreenUpdating = True
End Sub

Open in new window


see attached demonstration workbook.

Dave
copyrows-r1.xls
0
 
LVL 43

Assisted Solution

by:Saqib Husain, Syed
Saqib Husain, Syed earned 250 total points
ID: 37727506
Oops...no macro attached

Sub a()
Dim lr As Long, cel As Range, tws As Worksheet, Sws As Worksheet
Set Sws = Sheets("Sheet3")
Set tws = Sheets("Sheet1")
lr = Sws.Cells.Find("*", Range("A1"), , , , xlPrevious).Row + 1
For Each cel In Sws.Range("C1:C" & lr)
If cel.Value = "Brown" Then
cel.Offset(0, -2).Resize(1, 12).Copy tws.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next cel
End Sub
0
 
LVL 42

Accepted Solution

by:
dlmille earned 250 total points
ID: 37727513
Looks like my post prompted you, and then yours prompted me!

not blank cells, cells having BROWN!

Here's my repost:
Option Explicit

Sub copyRows()
Dim wkb As Workbook
Dim wks As Worksheet
Dim r As Range
Dim rng As Range
Dim lastRow As Long
Dim i As Long

    Application.ScreenUpdating = False
    
    Set wkb = ActiveWorkbook
    Set wks = wkb.ActiveSheet
    
    lastRow = wks.Range("A" & wks.Rows.Count).End(xlUp).Row
    Set rng = wks.Range("C1:C" & lastRow)
    For Each r In rng
        If UCase(r.Value) = "BROWN" Then
            wks.Range("A" & r.Row & ":L" & r.Row).Copy 'copy A:L on blank cell column C to bottom of existing worksheet
            wks.Range("A" & lastRow + i + 1).PasteSpecial
            Application.CutCopyMode = False
            i = i + 1
        End If

    Next r
        
    MsgBox "Process Complete"
    
    Application.ScreenUpdating = True
End Sub
Sub copyRowsNewWorksheet()
Dim wkb As Workbook
Dim wks As Worksheet
Dim wksOut As Worksheet
Dim r As Range
Dim rng As Range
Dim lastRow As Long
Dim i As Long

    Application.ScreenUpdating = False
    
    Set wkb = ActiveWorkbook
    Set wks = wkb.ActiveSheet
    Set wksOut = wkb.Worksheets.Add(after:=wkb.Worksheets(wks.Name))
    
    lastRow = wks.Range("A" & wks.Rows.Count).End(xlUp).Row
    Set rng = wks.Range("C1:C" & lastRow)
    For Each r In rng
        If UCase(r.Value) = "BROWN" Then
            wks.Range("A" & r.Row & ":L" & r.Row).Copy 'copy A:L on blank cell column C to bottom of existing worksheet
            wksOut.Range("A" & i + 1).PasteSpecial
            Application.CutCopyMode = False
            i = i + 1
        End If
    Next r
        
    MsgBox "Process Complete"
    
    Application.ScreenUpdating = True
End Sub

Open in new window


Attached find demo.  Should be a collaborative effort, lol.

Dave
copyrows-r2.xls
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Approximate matching with VLOOKUP and MATCH seems to me to be a greatly under-used technique, and one which is vital for getting good performance out of large lookups. Until recently I would always have advised using an exact match for simplicity an…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

808 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question