macro help

[Henry Chiavaroli]

This macro selects rows containing "qm" in a column on sheet check book balance and copies them to a new sheet labeled QM. In order to run it again I have to delete the sheet it created - QM.
I would like it to copy over existing sheets (QM,etc) and also be able to select other items in that same column and copy them to their respective sheets at the same time - mbr or t4t.
Is that possible or will I need seperate macros?

Sub ee_CheckBookSummary()
Dim ws As Worksheet, rng As Range, Remark As String, ws2 As Worksheet

Set ws = Sheets("Check book balance")
Remark = UCase("qm")
Set rng = ws.Range(Cells(3, 1), Cells(Rows.Count, Columns.Count).End(xlToLeft))
Sheets.Add(Sheets(Sheets.Count)).Name = Remark
Set ws2 = Sheets(Remark)

ws.Range("A3").AutoFilter 'NO BLANK ROWS; needs contiguous row data!
rng.AutoFilter Field:=9, Criteria1:=Remark
With ws
.UsedRange.SpecialCells(xlCellTypeVisible).Copy ws2.Range("A1")
.ShowAllData
End With
ws2.Cells.EntireColumn.AutoFit
End Sub

 

[Luke M]

Welcome to the forum Henry!

This code will copy over whatever the active cell is on. So, if active cell is "QM", will copy that, or if it's "t4t", will copy that.

Sub ee_CheckBookSummary()
Dim ws As Worksheet, rng As Range, Remark As String, ws2 As Worksheet

Application.ScreenUpdating = False

Set ws = ActiveSheet
Remark = UCase(ActiveCell.Value)
Set rng = ws.Range(Cells(3, 1), Cells(Rows.Count, Columns.Count).End(xlToLeft))

'Does sheet already exist?
On Error Resume Next
Set ws2 = Worksheets(Remark)
On Error GoTo 0

If Not ws2 Is Nothing Then
    ws2.Cells.ClearContents
Else
    Sheets.Add(Sheets(Sheets.Count)).Name = Remark
    Set ws2 = Sheets(Remark)
End If

ws.Range("A3").AutoFilter 'NO BLANK ROWS; needs contiguous row data!
rng.AutoFilter Field:=9, Criteria1:=Remark
With ws
    .UsedRange.SpecialCells(xlCellTypeVisible).Copy ws2.Range("A1")
    .ShowAllData
End With
ws2.Cells.EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub

 

[Henry Chiavaroli]

Welcome to the forum Henry!

This code will copy over whatever the active cell is on. So, if active cell is "QM", will copy that, or if it's "t4t", will copy that.

Sub ee_CheckBookSummary()
Dim ws As Worksheet, rng As Range, Remark As String, ws2 As Worksheet

Application.ScreenUpdating = False

Set ws = ActiveSheet
Remark = UCase(ActiveCell.Value)
Set rng = ws.Range(Cells(3, 1), Cells(Rows.Count, Columns.Count).End(xlToLeft))

'Does sheet already exist?
On Error Resume Next
Set ws2 = Worksheets(Remark)
On Error GoTo 0

If Not ws2 Is Nothing Then
    ws2.Cells.ClearContents
Else
    Sheets.Add(Sheets(Sheets.Count)).Name = Remark
    Set ws2 = Sheets(Remark)
End If

ws.Range("A3").AutoFilter 'NO BLANK ROWS; needs contiguous row data!
rng.AutoFilter Field:=9, Criteria1:=Remark
With ws
    .UsedRange.SpecialCells(xlCellTypeVisible).Copy ws2.Range("A1")
    .ShowAllData
End With
ws2.Cells.EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub

Macro stops here - creates new sheet with 23309.2 for label

rng.AutoFilter Field:=9, Criteria1:=Remark
With ws

 

[Luke M]

What message appears when it stops?

 

[Henry Chiavaroli]

what I posted above - rng------
I did it using the record macro - this works - can it be cleaned up
Sheets("Check book balance").Select
Range("A1").Select
ActiveWorkbook.Worksheets("Check book balance").AutoFilter.Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("Check book balance").AutoFilter.Sort.SortFields.Add _
Key:=Range("A2:A297"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Check book balance").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Range("$A$1:$J$297").AutoFilter Field:=9, Criteria1:="=a", _
Operator:=xlOr, Criteria2:="=cg"
Range("A1:J310").Select
Selection.Copy
Sheets("cg").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("F2").Select
Selection.ClearContents
Sheets("Check book balance").Select
ActiveSheet.Range("$A$1:$J$297").AutoFilter Field:=9, Criteria1:="=a", _
Operator:=xlOr, Criteria2:="=hh"
Range("A1:J310").Select
Selection.Copy
Sheets("hh").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("F2").Select
Selection.ClearContents
Sheets("Check book balance").Select
ActiveSheet.Range("$A$1:$J$297").AutoFilter Field:=9, Criteria1:="=a", _
Operator:=xlOr, Criteria2:="=la"
Range("A1:J310").Select
Selection.Copy
Sheets("la").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("F2").Select
Selection.ClearContents
Sheets("Check book balance").Select
ActiveSheet.Range("$A$1:$J$297").AutoFilter Field:=9, Criteria1:="=a", _
Operator:=xlOr, Criteria2:="=mbr"
Range("A1:J310").Select
Selection.Copy
Sheets("mbr").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("F2").Select
Selection.ClearContents
Sheets("Check book balance").Select
ActiveSheet.Range("$A$1:$J$297").AutoFilter Field:=9
Range("L13").Select
End Sub

 

[Luke M]

Now I'm more confused. You started with a macro that works, I presumed? I then modified that macro to accept whatever string/line you were on. You then told it the macro stopped, but I don't know what error appeared (object undefined, object missing, etc.). Also, as the sheet name is a number, it doesn't look like you select QM or some similar related string.

Then you post a new macro, which does other stuff like sorting, column widths, etc. Rather than me guessing what is going on, can you upload your workbook and a plain statement of what exactly you want/need to happen with it?

 

[Henry Chiavaroli]

I posted this before -
Macro stops here - creates new sheet with 23309.2 for label

rng.AutoFilter Field:=9, Criteria1:=Remark
With ws ***********this is where it stops

I'm trying to help out a group in the Marine Corps League where I live. I thought this would be a simple task but as it turns out, I have to have the macro "idiot proof" the work because there skills are very limited. Thats where all the additional stuff came in.
I think I can take it from here. Thanks for your help.
Next time I need to look before I leap.

 

[Luke M]

Ah, I cna sympathize with your plight. The bane of programmers...the universe always making a better idiot.