PDA

View Full Version : Need help with VBA and copying rows



Swamon
02-22-2017, 10:42 AM
Hi everybody. This is my first post. I’ve done a lot of research for what I want to do, and I’ve manage to make something that kind of works, but it’s not what I want. I’ve attached an example of our sales spreadsheet. I want to be able to automatically copy rows from one worksheet to another using VBA.

For example, in tab 12-13-13, I’d like to copy and paste based on the CLASS of the project. So if the CLASS is TULSA PROJECTS, I’d like it to paste into the Tulsa Active Projects tab in the next available row, and the same goes for the other options in the drop down. I’d like all projects to be copied into the Total Active Projects as well.

The last part I need help on is that I would like to be able to cut and paste based on the status dropdown. Whenever a project status is changed to READY TO INVOICE I’d like for it to cut and paste into the Ready To Invoice tab.

Any help is appreciated. I’m new to VBA, so any advice helps. In another worksheet I have it working, but I have to click a button to make it work, but I’d like it to be automatic.

p45cal
02-22-2017, 02:54 PM
For example, in tab 12-13-13, I’d like to copy and paste based on the CLASS of the project. So if the CLASS is TULSA PROJECTS, I’d like it to paste into the Tulsa Active Projects tab in the next available row

The last part I need help on is that I would like to be able to cut and paste based on the status dropdown. Whenever a project status is changed to READY TO INVOICE I’d like for it to cut and paste into the Ready To Invoice tab.

In another worksheet I have it working, but I have to click a button to make it work, but I’d like it to be automatic.
Which bit(s) do you have working in another worksheet? There's no point in re-writing code when it just needs tweaking. There's no code at all in your attachment.

Swamon
02-22-2017, 03:17 PM
Which bit(s) do you have working in another worksheet? There's no point in re-writing code when it just needs tweaking. There's no code at all in your attachment.

The only part that I have working is being able to copy from the 12-13-17 to the OKC and Tulsa with a button, but I want it to be automatic. Also, or some reason, the code I have won't paste into the correct row a lot of the time. I tried to make the cut and paste work, but I messed that up pretty bad. haha. The spreadsheet that I'm doing my test on is setup differently, but I'll attach it anyways. Thanks for the quick response.

p45cal
02-22-2017, 03:44 PM
Are you copy and pasting or cut and pasting (=moving) rows?

Swamon
02-23-2017, 07:02 AM
[QUOTE=p45cal;357153]Are you copy and pasting or cut and pasting (=moving) rows?[/QUOTE
I want to copy the information from 12-13-17 to the other sheets, but I want to cut and paste when a project is marked as ready to invoice as the status. Please, let me know if you need me to explain in a little more detail. Thanks for the help.

p45cal
02-23-2017, 09:16 AM
Test this code in the sheet 12-13-17's code module There has to be a sheet called Ready To Invoice of course.:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myCells As Range, RngToDelete As Range
Set myCells = Intersect(Target, Columns("A"), UsedRange)
With Sheets("Ready To Invoice")
If Not myCells Is Nothing Then
Application.EnableEvents = False
For Each cll In myCells.Cells
If cll.Value = "READY TO INVOICE" Then
cll.Resize(, 22).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
If RngToDelete Is Nothing Then Set RngToDelete = cll.Resize(, 22) Else Set RngToDelete = Union(RngToDelete, cll.Resize(, 22))
End If
Next cll
End If
End With
If Not RngToDelete Is Nothing Then RngToDelete.Delete shift:=xlUp
Application.EnableEvents = True
End Sub
and test this in a standard code module, and start it with a button click on the sheet that you want to copy from (to make sure that it's the active sheet when you run it):
Sub blah()
Set Startsht = ActiveSheet
Startsht.Range("A1").AutoFilter Field:=3, Criteria1:="TULSA"
With Intersect(Startsht.AutoFilter.Range, Startsht.AutoFilter.Range.Offset(1))
Set CellsToCopy = .SpecialCells(xlCellTypeVisible)
CellsToCopy.Copy Sheets("Tulsa").Cells(Rows.Count, "A").End(xlUp).Offset(1)
Startsht.Range("A1").AutoFilter Field:=3, Criteria1:="OKC"
Set CellsToCopy = .SpecialCells(xlCellTypeVisible)
Set InsertPoint = Sheets("OKC").Cells(Rows.Count, "A").End(xlUp)
InsertPoint.Offset(1).Resize(CellsToCopy.Cells.Count / CellsToCopy.Columns.Count, CellsToCopy.Columns.Count).Insert shift:=xlDown
CellsToCopy.Copy InsertPoint.Offset(1)
End With
Startsht.AutoFilter
End Sub

Swamon
02-23-2017, 03:35 PM
Did you make this code for the first file I sent? I'm very new to VBA, so I'm probably messing something up. I can't get the ready to invoice module to work at all or even do anything. The sub blah isn't working correctly either. It deletes all of the data and gives a run-time '1004: no cells were found. I've attached a picture of the debug for sub blah.18462

p45cal
02-23-2017, 05:04 PM
No, I've messed up, the Worksheet_Change code should go into both the Tulsa and OKC sheets' code modules, while the blah macro I wrote in the only file which had a Ready To Invoice sheet in, and should still be in a standard code module.

Swamon
02-27-2017, 08:07 AM
I'm still having the same issues with both of these macros.

p45cal
02-27-2017, 08:56 AM
Supply one workbook where both macros will be able to work; that is, the necessary data and sheets should be present.

Swamon
02-27-2017, 11:05 AM
Okay, I've attached an updated file that should have everything you need. Look at the 12-13-17 worksheet. It has some info in red that might help you understand what I want. Thanks again!

p45cal
02-27-2017, 12:52 PM
Well, if you didn't alter sheet names, columns where data is to be filtered, calculations at the bottom of some tables and not others, we'd have a chance!
Test the attached. Code in the ThisWorkbook code module and a standard module, nowhere else.
The blah code only handles Tulsa and OKC. I'll leave you to add your code
The code is in blocks like this:

Startsht.Range("A1").AutoFilter Field:=2, Criteria1:="OKC PROJECTS"
Set CellsToCopy = .SpecialCells(xlCellTypeVisible)
Set InsertPoint = Sheets("OKC Active Projects").Cells(Rows.Count, "A").End(xlUp)
InsertPoint.Offset(1).Resize(CellsToCopy.Cells.Count / CellsToCopy.Columns.Count, CellsToCopy.Columns.Count).Insert shift:=xlDown
CellsToCopy.Copy InsertPoint.Offset(1)

See the pattern?

Be aware that as soon as you select READY TO INVOICE in the Status column the line will whizz over to the Ready To Invoice sheet without further ado.
Note the one or two comments within the code.

Swamon
02-27-2017, 01:55 PM
You are my hero! I'm sorry I made that so difficult. It is working like a dream. I have a few more questions. Is there anyway that VBA will automatically create a new sheet every Monday with the date as the name? Also, will it be able to automatically put the macros in for the copying to the correct worksheets? Again, thank you so much!

p45cal
02-27-2017, 02:12 PM
Sub blah2()
Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = Format(Date, "mm-dd-yy")
End Sub
You could, I s'pose, schedule this (and add a line to schedule it for the following Monday) but I really doubt you'd want to do that.
Thee are no macros in individual worksheets, so there's nothing to copy. The blah macro works on whichever sheet is the active sheet.