ilrosebud26
asked on
Copy range of cells from one workbook to newly created workbook based on selection criterion
I have a spreadsheet with values that I need to copy to another based on a set of rules. I started a macro but cannot figure out how to tell it to run for the number of rows in the spreadsheet. The only thing I do know is that somewhere in the loop I need to tell it the last row. I have attached my spreadsheet and code for review. Any help would be appreciated.
Sub CreateFile()
Dim statuswb As Workbook
Dim I As Integer
Dim NS As Integer
Dim LastRow As Integer
I = 2 'Beginning point of the loop
NS = 1 'Beginning point of load file for status
LastRow = Range("A65536").End(xlUp).Row + 1
Set statuswb = Workbooks.Add
ActiveWorkbook.SaveAs Filename:="C:\my documents\Status" & CStr(Format(Now, "MMDDYYHHm")) & ".xls"
Windows("CreateFileDev.xls").Activate
Do While Cells(I, 10).Value <> "Y" And Cells(I, 11) <> "Not in System"
If Cells(I, 1) = "Modify Status" Then
Cells(I, 12).Select
Selection.Copy
statuswb.Activate
Cells(NS, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Windows("CreateFileDev.xls").Activate
Cells(I, 10).Select
ActiveCell.FormulaR1C1 = "Y"
End If
I = I + 1
NS = NS + 1
Loop
End Sub
CreateFileDev.xls
In my opinion, the best way to process data tables like this is to use Excel's built-in function to return the last cell that contains data, as attached.
Sub CreateFile()
Dim statuswb As Workbook
Dim I As Integer
Dim NS As Integer
Dim LastRow As Integer
I = 2 'Beginning point of the loop
NS = 1 'Beginning point of load file for status
LastRow = Range("A1").SpecialCells(xlCellTypeLastCell).Row
Set statuswb = Workbooks.Add
ActiveWorkbook.SaveAs Filename:="C:\my documents\Status" & CStr(Format(Now, "MMDDYYHHm")) & ".xls"
Windows("CreateFileDev.xls").Activate
Do While I <= LastRow
If Cells(I, 1) = "Modify Status" Then
Cells(I, 12).Copy
statuswb.Activate
Cells(NS, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Windows("CreateFileDev.xls").Activate
Cells(I, 10).FormulaR1C1 = "Y"
End If
I = I + 1
NS = NS + 1
Loop
End Sub
You can also speed the routine up considerably if instead of activating each worksheet as you copy and paste, you set up variables and reference them directly. You may not notice a huge speed increase on the small table you have in your spreadsheet, but on a large table there will be a huge difference.
Sub CreateFile()
Dim statuswb As Workbook
Dim createFileDevwb As Workbook
Dim createFileDevWS As Worksheet
Dim statusWS As Worksheet
Dim I As Integer
Dim NS As Integer
Dim LastRow As Integer
I = 2 'Beginning point of the loop
NS = 1 'Beginning point of load file for status
LastRow = Range("A1").SpecialCells(xlCellTypeLastCell).Row
Set createFileDevwb = ActiveWorkbook ' Obtain a reference to this workbook (assumed active at macro start)
Set createFileDevWS = ActiveSheet
Set statuswb = Workbooks.Add
ActiveWorkbook.SaveAs Filename:="C:\my documents\Status" & CStr(Format(Now, "MMDDYYHHm")) & ".xls"
Set statusWS = ActiveSheet
Do While I <= LastRow
If createFileDevWS.Cells(I, 1) = "Modify Status" Then
statusWS.Cells(NS, 1).Value = createFileDevWS.Cells(I, 12).Value
createFileDevWS.Cells(I, 10).FormulaR1C1 = "Y"
End If
I = I + 1
NS = NS + 1
Loop
End Sub
ASKER
purplepomegranite-
Thanks for you quick reply. I will be able to try this out in the morning. I had to change gears for the rest of the day.
Rosemary
Thanks for you quick reply. I will be able to try this out in the morning. I had to change gears for the rest of the day.
Rosemary
ASKER
purplepomegranite-
This worked great! I just had the user through in another change. On the copy paste comand they want to copy the values in columns L(12) and M(13) to columns A(1) and B(2) on the vewly created workbook. Can you help me with that? I have increased the point value to reflect the additional question.
Thanks!
This worked great! I just had the user through in another change. On the copy paste comand they want to copy the values in columns L(12) and M(13) to columns A(1) and B(2) on the vewly created workbook. Can you help me with that? I have increased the point value to reflect the additional question.
Thanks!
ASKER CERTIFIED SOLUTION
membership
Create a free account to see this answer
Signing up is free and takes 30 seconds. No credit card required.
ASKER
You have been a great help with this. Thanks for your patience with a beginner!
ASKER
purplepomegranite-
After executing I realized that the new created sheet is not starting records in cell A1. Why? If I need to open an additional question....just let me know.
Rosemary
After executing I realized that the new created sheet is not starting records in cell A1. Why? If I need to open an additional question....just let me know.
Rosemary
It will copy the data to the same row in the new sheet i.e. if the data is in row 3 on the source sheet, it will be in row 3 of the target sheet. Also, if there is a gap (e.g. one line does not have a modify status set), then there will also be a gap on the results.
This can be amended, but probably does warrant another question. Try and be as specific as you can about how you want the output presented.
This can be amended, but probably does warrant another question. Try and be as specific as you can about how you want the output presented.
I hope this is not out of protocol here, but I'll throw you the answer anyway.
First, remove this line. It's not used.
Set statuswb = Workbooks.Add
Second, to do what you want, move the line
NS = NS + 1
into the if statement.
That'll only increment the row count as it copies the row into the new workbook.
First, remove this line. It's not used.
Set statuswb = Workbooks.Add
Second, to do what you want, move the line
NS = NS + 1
into the if statement.
That'll only increment the row count as it copies the row into the new workbook.
My last line wasn't clear. Here's what the loop should look like:
Do While I <= LastRow
If createFileDevWS.Cells(I, 1) = "Modify Status" Then
statusWS.Cells(NS, 1).Value = createFileDevWS.Cells(I, 12).Value
statusWS.Cells(NS, 2).Value = createFileDevWS.Cells(I, 13).Value
createFileDevWS.Cells(I, 10).FormulaR1C1 = "Y"
NS = NS + 1
End If
I = I + 1
Loop
Do While I <= LastRow
If createFileDevWS.Cells(I, 1) = "Modify Status" Then
statusWS.Cells(NS, 1).Value = createFileDevWS.Cells(I, 12).Value
statusWS.Cells(NS, 2).Value = createFileDevWS.Cells(I, 13).Value
createFileDevWS.Cells(I, 10).FormulaR1C1 = "Y"
NS = NS + 1
End If
I = I + 1
Loop
The line:
Set statuswb = Workbooks.Add
IS used, it's just the variable that isn't. The line shouldn't be removed. It could be changed to:
Workbooks.Add
However, leaving it as it is means that there is a reference to the workbook in case it is needed for future modifications.
Set statuswb = Workbooks.Add
IS used, it's just the variable that isn't. The line shouldn't be removed. It could be changed to:
Workbooks.Add
However, leaving it as it is means that there is a reference to the workbook in case it is needed for future modifications.
You're right purple. I'm helping someone else with the same issue but working in the same workbook, so I got confused.
ASKER
I want to thank everyone for there help. This works now. I will try to be clearer on what I need.
Here, I'm testing for the first column of a row to not be "end". If it is, exit the loop. Otherwise, test every row in the sheet for the two conditions to be met for processing. I'm assuming you manually type in the word end into the last row's first cell.
Do While lcase(Cells(I, 1)) <> "end"
if Cells(I, 10).Value <> "Y" And Cells(I, 11) <> "Not in System"
If Cells(I, 1) = "Modify Status" Then
Cells(I, 12).Select
Selection.Copy
statuswb.Activate
Cells(NS, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Windows("CreateFileDev.xls
Cells(I, 10).Select
ActiveCell.FormulaR1C1 = "Y"
End If
I = I + 1
NS = NS + 1
Loop
End Sub