Macro to copy rows to different worksheet based on specific cell values

[Godspeed64]

Hi all. I'm completely new to the world of excel (just started using it a month plus ago, and have learnt the basic functions like Pivoting and VLOOKUP), but I need some help in learning macros.


Currently, I am designing in template that requires a specific function and I've read multiple threads and watched a few videos, blindly following the commands and watching them fail.


Basically, I would want a Command button for a worksheet, that would copy paste (special) rows into two different worksheets, based on cell values.
In my worksheet, A5 to U5 would be the headers.
My "trigger" cells are O6 and Q6 onwards (in a year, it would roughly reach 300 rows). If "O" hits a probability and matches the status in "Q, clicking on the Command button would copy this row (from A6 to U6) into another sheet.
Eg. O6 is 100%, Q6 is WIN, the entire row is pasted into a different master worksheet. If O6 is 0% and Q6 is LOST, there is another worksheet the data has to go to. The two cells are data validated and have conditional formatting to reduce human error, now I'm trying to automate the process for efficiency and cleaner data.


The end result is that 6 worksheets managed by different people (I will reuse the code of the command button if I understand the logic), would have command buttons each that feed 2 specific worksheets for WIN and LOST. The code has to keep adding on rows that qualify to the two worksheets, without double counting those that have already been pasted into the worksheet.


I thank you if you can lead me to a relevant video, tutorial, or assist me in teaching me how to code. I enjoy using excel in the past month and have done so much with it!
Thank you. :D

 

[shadow12345]

Hi Godspeed64 welcome to the board...

So I have had a look at what you have said, and I do have some suggestions for you. First of which have a look at the forums sticky posts (at the top) they have some very useful addin's for excel, including instruction about how to put your spreadsheets onto the board so we can see the data (much easier that us trying to guess where and what the data is)


Right, teach to code... been doing this for about 10 years and I don't know it yet, but there are so good books on here that I ordered so have at look at those. Best advice I can offer is that you can watch the macro recorder while its records code, so play with it, then once you have that, start looking at trimming and adding speed.

But on to your specific question. Seems to me that you know what you want but haven't quite given enough information for us to be able to help you. Let me try and do something with the information we do have though. Lets break down what you want to do into smaller parts if the first stage:


For every cell from 06 onward if the value of that cell is 100% and value in Q on that row = "WIN" then you want to copy that data to another worksheet....

For every cell from 06 onward if the value of that cell is 0% and value in Q on that row = "LOST" then you want to copy that data to another worksheet....

Anyway, I have talked enough. Below is the code you asked about, I have added as many comments as I can so you understand how it works. Remenber this is only 1 way, and it assumes the sheet with data is called "Master" and the other two sheets are called "Win" and "Lost"


Good luck

Sub Marine()
Dim LR As Long
Dim C As Range
Dim Mastersheet As Worksheet
Dim Pastesheet As Worksheet

'Find the last row with data in column O
LR = ActiveSheet.Cells(Rows.Count, "O").End(xlUp).Row

'look at every cell in o6 onwards
For Each C In Range("O6:O" & LR)

    If C.Value = 1 Then    'check to See if O6 equals 100% which excel reads as 1 not 100
    
        If C.Offset(0, 1).Value = "WIN" Then   ' If o6 is 100% check to see if Q6 (thats the offset) is "WIN"
        
            'Here we put the copy code
            
            
            Set Mastersheet = Worksheets("Master")  ' Copy From this sheet
            Set Pastesheet = Worksheets("WIN")  ' to this sheet
            
            C.EntireRow.Copy  ' copy the row from column O that meets that requirements (above, 1 and also win in Q)
            
            Pastesheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
         
            
      
        
        End If
    
    End If
          
   
    'While we are looking at O6, lets check to see if then value is 0%
    
    If C.Value = "0" Then   'check to See if O6 equals 0 ... which excel doesn't see the % sign
    
        If C.Offset(0, 1).Value = "LOST" Then   ' If o6 is 0% check to see if Q6 (thats the offset) is "LOST"
        
            'Here we put the copy code
            Set Mastersheet = Worksheets("Master") ' Copy From this sheet
            Set Pastesheet = Worksheets("LOST") ' to this sheet
            
            C.EntireRow.Copy   ' copy the row from column O that meets that requirements (above, 1 and also win in Q)
            
            Pastesheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
         
        
        
        End If
    
    End If
    
    
    
    

Next C  ' Now we check the next cell in column O ... so O7, then O8 and so on



End Sub

****Edit**** there are other faster and better ways im sure but this will at least give you are start. ****

 

[Godspeed64]

Hi Sir.

Thank you for your assistance. Unfortunately due to the nature of my work, I am unable to download add-ins and install them, nor can I share the worksheet I'm working on; hence I'm forced to communicate in such a way.

Thanks for pointing me in the right direction; I will study and attempt to comprehend the process so that I pass on the good karma in the future! Before I get to books, I have the intention of signing up for internal Excel workshops. Hopefully that will teach me the language of coding. Thanks once again!

 

[L. Howard]

Hi Godspeed64,

Try something like this in the sheet module

Regards,
Howard

Option Explicit

Sub WinLost()
Dim c As Range
Application.ScreenUpdating = False

For Each c In Range("O6:O" & Cells(Rows.Count, "O").End(xlUp).Row)
     
   If c = 1 And c.Offset(, 2) = "Win" Then
       c.EntireRow.Copy
         Sheets("Win").Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
            
     ElseIf c = 0 And c.Offset(, 2) = "Lost" Then
       c.EntireRow.Copy
         Sheets("Lost").Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
        
   End If
    
Next c

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[Godspeed64]

Hi Howard and Shadow,

Thanks for the help. (Shadow the explanations are so clear!)

I've tried both codes and both can't seem to paste as intended. Is it because the WIN and LOST worksheets denoted is a similar table, where the rows will begin from Row 6 again?
For reference in both the Master and Paste sheets, Row 5 is my header, Row's 1-4 contain formulas to calculate a summary with a graph on it.

Thanks for taking the time.

 

[L. Howard]

The code should paste to the first empty row on either Win or Lost sheet if there is a header. If no header then it will leave a one row gap and then paste in the next empty row. As written, the (2) in the copy code line does that. So if you have headers in row 5, it should paste in row 6 and then in each new row below the last.

However, if the entire row on Master sheet does not have anything in column A that may cause a problem in how it pastes in Win and Lost sheets.

You may not need the entire row to be copied, as I am some what sure you do not data from column A column XFD.

Can you tell me what an "Entire Row" on Master sheet looks like? From column A to whatever column to the right.

Howard

 

[Godspeed64]

Hi Howard,

Rows 1-4 are summaries and a bar graph. My command button to run the code above is also located here.

Row 5 would be my headers.
A is type of business, B is client name, C is date, and so forth until column U which is the name of the staff.
All the data is required from the row.

My paste sheet is exactly the same as the master sheet, just that it compiles from 6 different operators Wins and Losses.
Rows 1-4 would be the summary for the team, Row 5 headers, Row 6 onwards would be the data.

 

[L. Howard]

Hi Godspeed64,


Not sure what you mean by this.

I've tried both codes and both can't seem to paste as intended.

What does the destination paste do or not do? Or is the data copied incorrect.


This code copies from column A to column U and pastes to row 6 on my test sheets, where I have row 5 filled with headers column A to U.

However, in reality, only column A needs to have the header since that is the column used to determine the paste row.

 Sheets("Win").Range("[COLOR="#FF0000"]A[/COLOR]" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues

Howard

Option Explicit

Sub WinLost()
Dim c As Range
Application.ScreenUpdating = False

For Each c In Range("O6:O" & Cells(Rows.Count, "O").End(xlUp).Row)
     
   If c = 1 And c.Offset(, 2) = "Win" Then
       c.Offset(, -14).Resize(1, 21).Copy
         Sheets("Win").Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
            
     ElseIf c = 0 And c.Offset(, 2) = "Lost" Then
       c.Offset(, -14).Resize(1, 21).Copy
         Sheets("Lost").Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
        
   End If
    
Next c

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[Godspeed64]

Hi Howard,

The code works! Thank you so much!

However, how do I prevent duplication in the compiled list?
Let's say 10 items fulfil the condition and my Command button copies the list over to the relevant sheets.
If another 15 rows are filled and again fulfil the conditions, the Command button copies all 25 and not just the 15 new ones.

Regards.

 

[L. Howard]

Hi Godspeed64,

See if this works for you.

You will need a "helper column" and here I have used column V. (can be farther to the right if necessary)

If the data is copied for the first time then the text "Cpy" is entered into the V column row of the row copied.

The codes now looks to see if there is NOT a "Cpy" in column V, and if none then copies that row, else it skips that row.

Howard

Option Explicit

Sub WinLost_Cpy()
Dim c As Range
Application.ScreenUpdating = False

For Each c In Range("O6:O" & Cells(Rows.Count, "O").End(xlUp).Row)
     
   If c = 1 And c.Offset(, 2) = "Win" And c.Offset(, 7) <> "Cpy" Then
       c.Offset(, 7) = "Cpy"
       c.Offset(, -14).Resize(1, 21).Copy
         Sheets("Win").Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
            
     ElseIf c = 0 And c.Offset(, 2) = "Lost" And c.Offset(, 7) <> "Cpy" Then
       c.Offset(, 7) = "Cpy"
       c.Offset(, -14).Resize(1, 21).Copy
         Sheets("Lost").Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
        
   End If
    
Next c

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub