Select rows with certain values, cut, paste into new worksheet

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hi,

I've searched for similar situations to mine in the discussion pages but
can't piece together all the answers properly to get what I need!

I want to select and cut all rows from my worksheet where column I = "S"
then paste these into a seperate tab (and name this 'Sundries' if possible)???

Also, how do i use code to subtotal different values within the worksheet?

Thanks, Mel
 
Why use code? How about Pivot Tables or Filters? It can be done in code but
the end result will be the same...
 
Hi, sorry that does look a bit confusing!
I mean I want to select, cut and paste to seperate tab all rows where column
I has the letter S in it. (Column I is showing movement types, and are either
S or A).
Thanks for quick reply! :-)
 
Hi Jim,

I'd prefer code as I'm writing a macro to help users cut down on manual
spreadsheet fiddling! This step is just one in a long line of many cut and
paste actions they do to get a couple of figures at the end.

Thinking about it actually...
I could just use subtotals instead...

Do you know how I subtotal using code?

Thanks :-)
 
Here is some code to move the items.

Sub MoveStuff()
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngFoundAll As Range
Dim rngPaste As Range
Dim strFirstAddress As String

Set rngPaste = Sheets("Sundries").Cells(Rows.Count, _
"A").End(xlUp).Offset(1, 0)
Set rngToSearch = ActiveSheet.Columns("I")
Set rngFound = rngToSearch.Find(What:="S", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)
If rngFound Is Nothing Then
MsgBox "There are no items to move."
Else
Set rngFoundAll = rngFound
strFirstAddress = rngFound.Address
Do
Set rngFoundAll = Union(rngFound, rngFoundAll)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress

rngFoundAll.EntireRow.Copy Destination:=rngPaste
rngFoundAll.EntireRow.Delete 'Optional to Delete
End If
End Sub

It moves the data. I personally would be more inclined to not delete the
sundry items from the source data sheet but that is up to you...
 
Mel... It sounds like the SumIF function will work with or without
code.... have you looked at it...

Would need more data to help with code

Dex
 
BRILL! Thanks Jim,

I removed the delete line, good thinking!
A couple of things...

1. The code worked once I'd added the Sundries sheet in manually (how do I
add the tab automatically with code?)

2. How do I name that tab 'Sundries - X' where X would be the autosum value
of column G??

Thanks for that code.
 
Hi Dex,

My data looks like below...

I need to subtotal column G for all S values in column I.
Also subtotal column G for all negative A values in column I.
Also subtotal column G for all postive A values in column I.

062649 IN -1 1060609 -5.53 bsf375/rich S
069350 IN -1 1060607 -17.1 BSF375/DAN S
D27997 EW -1401 1060608 -448.32 BSF084/DAN A

SUMIF looks like it could be useful but I'm having a bit of a dunce day and
can't get my head around it!! This should be easy but its doing my head in!!
Thanks so much for your help...

Mel
 
Try this...

Sub CopySundries()
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngFoundAll As Range
Dim rngPaste As Range
Dim strFirstAddress As String
Dim strSheetName As String
Dim wksPaste As Worksheet

strSheetName = "Sundires - " & Round(Application.Sum(Columns("G")), 2)
If SheetExists(strSheetName) Then
MsgBox "Sheet " & strSheetName & " already exists. Please " & _
"delete or rename."
Exit Sub
End If

Set rngToSearch = ActiveSheet.Columns("I")
Set rngFound = rngToSearch.Find(What:="S", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)
If rngFound Is Nothing Then
MsgBox "There are no items to move."
Else
Set rngFoundAll = rngFound
strFirstAddress = rngFound.Address
Do
Set rngFoundAll = Union(rngFound, rngFoundAll)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress

Set wksPaste = Worksheets.Add(After:=ActiveSheet)
With wksPaste
wksPaste.Name = strSheetName
Set rngPaste = wksPaste.Range("A2")
End With
rngFoundAll.EntireRow.Copy Destination:=rngPaste
End If
End Sub

Public Function SheetExists(SName As String, _
Optional ByVal Wb As Workbook) As Boolean
'Chip Pearson
On Error Resume Next
If Wb Is Nothing Then Set Wb = ThisWorkbook
SheetExists = CBool(Len(Wb.Sheets(SName).Name))
End Function
 
Try sumproduct formulas...

=SUMPRODUCT(--($I$2:$I$1000="s"), --($G$2:$G$1000))
=SUMPRODUCT(--($I$2:$I$1000="s"), --($G$2:$G$1000<0), --($G$2:$G$1000))
=SUMPRODUCT(--($I$2:$I$1000="s"), --($G$2:$G$1000>0), --($G$2:$G$1000))
 
Thanks for this Jim, I hope you had a nice weekend

This works great, just what I wanted, however I'm having trouble changing
the sum figure on the tab name to pick up sum of column G on the new sundries
sheet not the original sheet. I dont want to mess the whole thing up!!

strSheetName = "Sundries - " & Round(Application.Sum(Columns("G")), 2)

One last bit of help would be brilliant! Thanks, Mel :-)
 
Back
Top