Simple macro to cut and paste 1

[Allilue]

hi,

this is a pretty simple macro i'm trying to create. basically, i can't do any code, but wanted to know if you could provide the "shell" of this macro to help me out.

I have 2 worksheets in excel. The sheets are pretty much identical. Based on 2 criteria in Sheet A, I would like to have a button that transfers the row from this template to a row on Sheet B. The two criteria are:

Column A = 100%
Column B is "ticked" (I have a tickbox in the cell)

Since both pages are ongoing with inputs, I don't know if there will be a problem to, when the template rows run out on Sheet B, then it's not just pasting the data under the last row, but there would need to be a row inserted and then copied.

Hope this makes sense. I don't know if you provide this kind of help, but anything you can would be great!

Thanks,
Allison

 

[APElliott]

Hi there,

Here is a bit of code I have used!

You will have to change the names to suit your workbook!

Hope it helps

Andrew

Sheets("Labour&quot.Select
LRow = Range("a65536&quot.End(xlUp).Row
Columns("j:j&quot.AutoFilter Field:=1, Criteria1:=">0", Operator:=xlOr, _
Criteria2:=&quot;<0&quot;
Range(&quot;A2:A&quot; & LRow & &quot;, c2:c&quot; & LRow & &quot;, f2:H&quot; & LRow & &quot;, j2:j&quot; & LRow).Copy
Sheets(&quot;Labour Report&quot.[a4].PasteSpecial xlPasteValues
Columns(&quot;j:j&quot.AutoFilter

 

[Allilue]

hi again,

wow. that looks good, but i think i'm completely lost! (

maybe this will help:

Copy from sheet &quot;Monthly Sales Forecast&quot;
Copy to sheet &quot;Actuals - Sold&quot;

Criteria1 - range ba:ba=100%
Criteria2 - range bd:bd is &quot;ticked&quot;... there is a checkbox here but how do i connect it to the cell?

I need to cut the entire row and paste it into the Sold - Actuals sheet, but the catch is that i don't want to take a row away from the original sheet. or this would cut the entire row, but replace a new row at the bottom of the list...

sorry to complicate things. i'm still not very good at this!

thanks!
allison

 

[Nelviticus]

Hello Allilue,

In order to link the checkbox to a cell you need to edit its properties. To do this, go to the 'View' menu, select 'Toolbars' and make sure that the 'Control Toolbox' is checked. On this toolbar there's a 'Design Mode' button - it looks like a blue triangle. Toggle this to 'on'. You can now right-click your check-box and select 'Properties'. One of the properties of the check-box is 'Linked Cell', and you just change this to the cell you want.

If there's an easier way of doing this I'd love to know what it is!

Regarding the rest of your problem, do you actually want to remove rows from the first sheet, so that the rows underneath it move up, or do you just want to remove the values in the row, leaving a blank line?

Nelviticus

 

[Allilue]

Thanks for the reply!

I want to remove the row so that the rows underneath it move up (I then have an &quot;addline&quot; button/macro to allow the user to add more lines to the template).

This &quot;cut&quot; row will then be transferred to the SOld - Actuals sheet. But I'll need it to paste UNDER the last line, so this will have to add a line instead of just paste value.

Thanks for the linked cell tip!!

Allison

 

[Nelviticus]

OK, the following function is a real hatchet-job but it should roughly do what you're after, I think:

Sub DoIt()
    
    Const lngVALCOL As Long = 1     ' Column containing % value to test
    Const lngCHECKCOL As Long = 4   ' Column containing checkbox value to test
    
    Const strSOURCESHEET As String = "Monthly Sales Forecast"    ' Source worksheet name
    Const strDESTSHEET As String = "Actuals - Sold"              ' Destination sheet name
    
    Dim wsSource As Worksheet       ' Source worksheet
    Dim wsDest As Worksheet         ' Destination worksheet
    
    Dim lngSourceRow As Long        ' Current row being examined
    Dim lngDestRow As Long          ' Destination row
    
    Set wsSource = Worksheets(strSOURCESHEET)
    Set wsDest = Worksheets(strDESTSHEET)
    
    lngSourceRow = 1
    
    ' Find last row in destination sheet
    lngDestRow = wsDest.UsedRange.Rows.Count + 1
    
    With wsSource
        
        ' Keep going until either of our test cells is empty
        Do While Not IsEmpty(.Cells(lngSourceRow, lngVALCOL)) And _
            Not IsEmpty(.Cells(lngSourceRow, lngCHECKCOL))
            
            ' If the Value cell is 100% and the checkbox cell is TRUE
            If .Cells(lngSourceRow, lngVALCOL).Value = 1 And _
                .Cells(lngSourceRow, lngCHECKCOL).Value = True Then
                
                ' Cut the row
                .Rows(lngSourceRow).Cut
                
                ' Paste it into the destination sheet
                wsDest.Select
                wsDest.Rows(lngDestRow).Select
                wsDest.Paste
                
                ' Delete the original row
                .Rows(lngSourceRow).Delete Shift:=xlUp
                
                lngDestRow = lngDestRow + 1
                
            End If
            
            lngSourceRow = lngSourceRow + 1
            
        Loop
        
    End With
    
End Sub

It could be done a lot neater but it will hopefully work for you. NB, it assumes that both your source and destination worksheets are open, I haven't put in any code for checking this.

You'll need to change the constants lngVALCOL and lngCHECKCOL to the right numbers - if your percentages are in column BA and your checkboxes are linked to values in column BD, the numbers will be 53 and 56.

Nelviticus

 

[Allilue]

WOW! thanks!

Const lngVALCOL As Long = 1
Const lngCHECKCOL As Long = 4

is that where i substitute the column numbers? (Sorry! i know it's a dumb question..!)

 

[Nelviticus]

Yup, 1 = A, 2 = B, ... 26 = Z, 27 = AA and so on.

Don't thank me until it works!

Nelviticus

 

[Allilue]

ok, something is not working. i clicked the button with your code attached, and nothing happened. I've set the columns:
Const lngVALCOL As Long = 53
Const lngCHECKCOL As Long = 56
and have corrected one of the names of my sheets &quot;Sold - Actuals&quot;. -- so i know it's doing something since when i spelled my ws wrong, i got an error.

any suggestions of how to find out what specifically isn't working?

)

 

[Nelviticus]

Could be anything, but I made a few assumptions that I shouldn't have - always a bad idea.

My function starts looking in row 1 of your source sheet and keeps going until one of the cells you're testing is empty. If you don't have any data in the first row, it will stop straight away.

If your data doesn't start until row 3, for example, you'll need to change the line

lngSourceRow = 1

to

lngSourceRow = 3

.

Does that help?

Nelviticus

 

[Allilue]

it worked! it worked!

thanks! ) ) )

 

[punchedin]

HI Nelviticus,

I tried to use your code. The sheet names I used was sheet1 and sheet2. I changed the value to "NRIC". For some reason it will move some of the rows but not all of the rows. Do you have any idea why? This is what I have:





Sub DoIt()

Const lngVALCOL As Long = 6

Const strSOURCESHEET As String = "Sheet1"
Const strDESTSHEET As String = "Sheet2"

Dim wsDest As Worksheet
Dim lngSourceRow As Long
Dim lngDestRow As Long

Set wsSource = Worksheets(strSOURCESHEET)
Set wsDest = Worksheets(strDESTSHEET)

lngSourceRow = 2

lngDestRow = wsDest.UsedRange.Rows.Count + 1

With wsSource
Do While Not IsEmpty(.Cells(lngSourceRow, lngVALCOL))
If .Cells(lngSourceRow, lngVALCOL).Value = "NRIC" Then
.Rows(lngSourceRow).Cut
wsDest.Select
wsDest.Rows(lngDestRow).Select
wsDest.Paste
.Rows(lngSourceRow).Delete Shift:=xlUp

lngDestRow = lngDestRow + 1

End If

lngSourceRow = lngSourceRow + 1

Loop

End With

End Sub

 

[xlbo]

Wheneveer you delete rows, it is better to work from the bottum up as otherwise the action of deleting the row messes up excel's loop.

I'm willing to bet that the rows it "misses" are ones where there were originally 2 next to each other that would meet the logic test

If you just want to cut those rows that have NRIC in a column, have a think about using AUTOFILTER and then just cutting the whole block in 1 go - saves looping

Rgds, Geoff

"Three things are certain: Death, taxes and lost data. Guess which has occurred"

Please read FAQ222-2244 before you ask a question

 

[punchedin]

The only problem with that is I have 10 other criterias I would like to run this for. For example: column F have ABC then move to sheet 3. If Column F have XYZ then move to sheet 4. I was just trying to get the first one to work. Any other suggestions.

 

[xlbo]

Well - I have given you 2 already - 1 that will mean you pick up ALL rows and 1 that will significantly reduce the amount of time taken to perform the action. Have a look at the AUTOFILTER method in help - just use a loop and specify the different criteria each time.....Also sounds like you should look into SELECT CASE for the different actions

Rgds, Geoff

"Three things are certain: Death, taxes and lost data. Guess which has occurred"

Please read FAQ222-2244 before you ask a question

 

[punchedin]

I did get it to work with the auto filter but I still have a problem. I coppied this code for each possible criteria. it is possible that not all of the criterias will be used. Once my code hits a criteria that is not in column F I get an error. Is there a way around it?


Set Sh1 = Worksheets("Sheet1")
Set Rng = Sh1.Range("A1").CurrentRegion
Set Sh2 = Worksheets("Sheet2")
Rng.AutoFilter Field:=6, Criteria1:="NRIC"
Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1)
Set Rng = Rng.SpecialCells(xlCellTypeVisible)

Rng.Areas(1).Copy Sh2.Range("A" & Sh2.UsedRange.Rows.Count + 1)

 

[punchedin]

I did take the route of using a filter. Thanks. However I still have one problem. Column F Can contain multiple values. The value determines what sheet they go to. I put in code to account for all possible values for column F. My problem occurs when one of the values is not in column F (which is possible). If a value is not there is will list all the values on the next sheet. Please let me know if I need to go into more detail. Here is the code I used.

Sub Test()

Dim Sh1 As Worksheet
Dim Rng As Range
Dim Sh2 As Worksheet
Dim Rng2 As Range
Dim Rng3 As Range


Set Rng2 = Range("f2:f600").Find(What:="IC", LookAt:=xlWhole, LookIn:=xlValues)
If Not Rng2 Is Nothing Then

Set Sh1 = Worksheets("Sheet1")
Set Rng = Sh1.Range("A1").CurrentRegion
Set Sh2 = Worksheets("Sheet2")
Set Sh3 = Worksheets("Sheet3")
Set Sh4 = Worksheets("Sheet4")
Set Sh5 = Worksheets("Sheet5")
Set Sh6 = Worksheets("Sheet6")
Rng.AutoFilter Field:=6, Criteria1:="IC"
Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1)
Set Rng = Rng.SpecialCells(xlCellTypeVisible)

Rng.Areas(1).Copy Sh2.Range("A" & Sh2.UsedRange.Rows.Count + 1)


End If
Rng.AutoFilter

Set Rng2 = Range("f2:f600").Find(What:="NRIC", LookAt:=xlWhole, LookIn:=xlValues)
If Not Rng2 Is Nothing Then

Set Sh1 = Worksheets("Sheet1")
Set Rng = Sh1.Range("A1").CurrentRegion
Set Sh2 = Worksheets("Sheet2")
Rng.AutoFilter Field:=6, Criteria1:="NRIC"
Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1)
Set Rng = Rng.SpecialCells(xlCellTypeVisible)

Rng.Areas(1).Copy Sh2.Range("A" & Sh2.UsedRange.Rows.Count + 1)

End If
Rng.AutoFilter

Set Rng2 = Range("f2:f600").Find(What:="FNDD", LookAt:=xlWhole, LookIn:=xlValues)
If Not Rng2 Is Nothing Then

Set Sh1 = Worksheets("Sheet1")
Set Rng = Sh1.Range("A1").CurrentRegion
Set Sh3 = Worksheets("Sheet3")
Rng.AutoFilter Field:=6, Criteria1:="FNDD"
Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1)
Set Rng = Rng.SpecialCells(xlCellTypeVisible)

Rng.Areas(1).Copy Sh3.Range("A" & Sh3.UsedRange.Rows.Count + 1)

End If
Rng.AutoFilter

Set Rng2 = Range("f2:f600").Find(What:="WBCD", LookAt:=xlWhole, LookIn:=xlValues)
If Not Rng2 Is Nothing Then

Set Sh1 = Worksheets("Sheet1")
Set Rng = Sh1.Range("A1").CurrentRegion
Set Sh3 = Worksheets("Sheet3")
Rng.AutoFilter Field:=6, Criteria1:="WBCD"
Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1)
Set Rng = Rng.SpecialCells(xlCellTypeVisible)

Rng.Areas(1).Copy Sh3.Range("A" & Sh3.UsedRange.Rows.Count + 1)

End If
Rng.AutoFilter


Set Rng2 = Range("f2:f600").Find(What:="RESC", LookAt:=xlWhole, LookIn:=xlValues)
If Not Rng2 Is Nothing Then

Set Sh1 = Worksheets("Sheet1")
Set Rng = Sh1.Range("A1").CurrentRegion
Set Sh3 = Worksheets("Sheet3")
Rng.AutoFilter Field:=6, Criteria1:="RESC"
Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1)
Set Rng = Rng.SpecialCells(xlCellTypeVisible)

Rng.Areas(1).Copy Sh3.Range("A" & Sh3.UsedRange.Rows.Count + 1)

End If
Rng.AutoFilter

Set Rng2 = Range("f2:f600").Find(What:="PCP", LookAt:=xlWhole, LookIn:=xlValues)
If Not Rng2 Is Nothing Then

Set Sh1 = Worksheets("Sheet1")
Set Rng = Sh1.Range("A1").CurrentRegion
Set Sh4 = Worksheets("Sheet4")
Rng.AutoFilter Field:=6, Criteria1:="PCP"
Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1)
Set Rng = Rng.SpecialCells(xlCellTypeVisible)

Rng.Areas(1).Copy Sh4.Range("A" & Sh4.UsedRange.Rows.Count + 1)

End If
Rng.AutoFilter

Set Rng2 = Range("f2:f600").Find(What:="SHIP", LookAt:=xlWhole, LookIn:=xlValues)
If Not Rng2 Is Nothing Then

Set Sh1 = Worksheets("Sheet1")
Set Rng = Sh1.Range("A1").CurrentRegion
Set Sh5 = Worksheets("Sheet5")
Rng.AutoFilter Field:=6, Criteria1:="SHIP"
Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1)
Set Rng = Rng.SpecialCells(xlCellTypeVisible)

Rng.Areas(1).Copy Sh5.Range("A" & Sh5.UsedRange.Rows.Count + 1)

End If
Rng.AutoFilter

Set Rng2 = Range("f2:f600").Find(What:="NASP", LookAt:=xlWhole, LookIn:=xlValues)
If Not Rng2 Is Nothing Then

Set Sh1 = Worksheets("Sheet1")
Set Rng = Sh1.Range("A1").CurrentRegion
Set Sh5 = Worksheets("Sheet5")
Rng.AutoFilter Field:=6, Criteria1:="NASP"
Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1)
Set Rng = Rng.SpecialCells(xlCellTypeVisible)

Rng.Areas(1).Copy Sh5.Range("A" & Sh5.UsedRange.Rows.Count + 1)

End If
Rng.AutoFilter

Set Rng2 = Range("f2:f600").Find(What:="NPRB", LookAt:=xlWhole, LookIn:=xlValues)
If Not Rng2 Is Nothing Then

Set Sh1 = Worksheets("Sheet1")
Set Rng = Sh1.Range("A1").CurrentRegion
Set Sh5 = Worksheets("Sheet5")
Rng.AutoFilter Field:=6, Criteria1:="NPRB"
Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1)
Set Rng = Rng.SpecialCells(xlCellTypeVisible)

Rng.Areas(1).Copy Sh5.Range("A" & Sh5.UsedRange.Rows.Count + 1)
End If

Rng.AutoFilter

Set Rng2 = Range("f2:f600").Find(What:="NASR", LookAt:=xlWhole, LookIn:=xlValues)
If Not Rng2 Is Nothing Then

Set Sh1 = Worksheets("Sheet1")
Set Rng = Sh1.Range("A1").CurrentRegion
Set Sh5 = Worksheets("Sheet5")
Rng.AutoFilter Field:=6, Criteria1:="NASR"
Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1)
Set Rng = Rng.SpecialCells(xlCellTypeVisible)

Rng.Areas(1).Copy Sh5.Range("A" & Sh5.UsedRange.Rows.Count + 1)

End If

Rng.AutoFilter

End Sub

 

[xlbo]

Ok - 1st things 1st, you only need to SET your variables once - that should get rid of a fair few lines of code. There is already a check for whether the values exist in the data:

 Set Rng2 = Range("f2:f600").Find(What:="IC", LookAt:=xlWhole, LookIn:=xlValues)
  If Not Rng2 Is Nothing Then

so I am not sure what is causing the error - can you highlight the line that errors ?

Rgds, Geoff

"Three things are certain: Death, taxes and lost data. Guess which has occurred"

Please read FAQ222-2244 before you ask a question

 

[punchedin]

There is not a line that errors. The problem is with the data that is displayed. Here is an example of what is happening. The following catagories should be displayed in sheet 5: SHIP, NASP, NPRB, AND NASR. The code will do this if they are all on sheet 1. If sheet 1 does not have SHIP in cloumn F it will move this follow catagories to sheet 5: IC, NRIC, FNDD, RESC, NPRB, AND NASR. What it should do is only move NPRB and NASR.

Thanks for you time on this. Let me know if I need to explain it better.

 

[punchedin]

I was able to solve that problem by adding this before the End if:

Else
Rng.AutoFilter

Now it's giving me an error if the first catagory is not on sheet 1. The error is Run-time error '1004': Application-defined or object-defined error. any thoughts?