[2 days left] What’s wrong with your cloud strategy? Learn why multicloud solutions matter with Nimble Storage.Register Now

x
?
Solved

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

Posted on 2012-03-15
4
Medium Priority
?
313 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
[X]
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
  • 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 1000 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 1000 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

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

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

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

649 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