Stop Macro if there is no data

S

STEVEB

Hi,
Does anyone have any suggestions for the following:
I have a spreadsheet that looks at data and then sorts the data based
on certain text within the cell. The code works great when there are
several rows of data. However, when there is only 1 row of data or no
data for a particular day (This happens once or twice a month) the code
does not work.
Here is an example of the code:

Sub Test()

Range("D2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 =
"=IF(OR(ISNUMBER(SEARCH({""fee"",""inter""},RC[-1]))),""F"",IF(OR(ISNUMBER(SEARCH({""transf"",""direct
pay"",""xf""},RC[-1]))),""T"",""O""))"
Range("C2").Select
Selection.End(xlDown).Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "end"
Selection.End(xlUp).Select
Selection.Copy
Range("D3").Select
Range(Selection, Selection.End(xlDown)).Select ActiveSheet.Paste
Range("D2").Select Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False Selection.Copy Selection.PasteSpecial
Paste:=xlValues

Range("A1").Select

Sheets("Sorted").Select
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="T"
Range("A2:d2").Select
Range(Selection, Selection.End(xlDown)).Select Selection.Copy
Sheets("transfers").Select Range("A2").Select ActiveSheet.Paste
Columns("A:d").Select Columns("A:d").EntireColumn.AutoFit
Sheets("Sorted").Select
Application.CutCopyMode = False
Selection.AutoFilter Field:=4, Criteria1:="O"
Range("A2:d2").Select
Range(Selection, Selection.End(xlDown)).Select Selection.Copy
Sheets("other").Select Range("A2").Select ActiveSheet.Paste
Columns("A:d").Select Columns("A:d").EntireColumn.AutoFit
Sheets("sorted").Select
Application.CutCopyMode = False
Selection.AutoFilter Field:=4, Criteria1:="F"
Range("A2:d2").Select
Range(Selection, Selection.End(xlDown)).Select Selection.Copy
Sheets("Fees-Interest").Select Range("A2").Select ActiveSheet.Paste
Columns("A:d").Select Columns("A:d").EntireColumn.AutoFit
Sheets("sorted").Select
Application.CutCopyMode = False

End Sub

Any Help would be greatly appreciated!!
 
T

Tom Ogilvy

Function HasData(sh as Worksheet) as Boolean
Dim rng1 as Range, rng2 as Range
HasData = True
On error resume next
set rng1 = sh.cells.specialcells(xlconstants)
set rng2 = sh.cells.specialcells(xlformulas)
On error goto 0
if rng1 is nothing and rng2 is nothing then
HasData = False
elseif not rng1 is nothing then
if rng1.rows.count < 2 then HasData = False
elseif
if rng2.rows.count < 2 then HasData = False
end if
end Function


set sh1 = Activesheet
if not hasdata(sh1) then
exit sub
end if

this assumes you are looking for a data table. It could give a technically
incorrect answer if you had say data in cells A1, B12, A15, Z31 but based on
your description, this should be treated as not having data.

to be specific if rng1 is a multiple area range, then the rows.count is
against the first area.

to illustrate from the immediate window:
set rng = Range("A1,15:50")
? rng.address
$A$1,$15:$50
? rng.rows.count
1

--
Regards,
Tom Ogilvy



STEVEB said:
Hi,
Does anyone have any suggestions for the following:
I have a spreadsheet that looks at data and then sorts the data based
on certain text within the cell. The code works great when there are
several rows of data. However, when there is only 1 row of data or no
data for a particular day (This happens once or twice a month) the code
does not work.
Here is an example of the code:

Sub Test()

Range("D2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 =
"=IF(OR(ISNUMBER(SEARCH({""fee"",""inter""},RC[-1]))),""F"",IF(OR(ISNUMBER(S
EARCH({""transf"",""direct
pay"",""xf""},RC[-1]))),""T"",""O""))"
Range("C2").Select
Selection.End(xlDown).Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "end"
Selection.End(xlUp).Select
Selection.Copy
Range("D3").Select
Range(Selection, Selection.End(xlDown)).Select ActiveSheet.Paste
Range("D2").Select Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False Selection.Copy Selection.PasteSpecial
Paste:=xlValues

Range("A1").Select

Sheets("Sorted").Select
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="T"
Range("A2:d2").Select
Range(Selection, Selection.End(xlDown)).Select Selection.Copy
Sheets("transfers").Select Range("A2").Select ActiveSheet.Paste
Columns("A:d").Select Columns("A:d").EntireColumn.AutoFit
Sheets("Sorted").Select
Application.CutCopyMode = False
Selection.AutoFilter Field:=4, Criteria1:="O"
Range("A2:d2").Select
Range(Selection, Selection.End(xlDown)).Select Selection.Copy
Sheets("other").Select Range("A2").Select ActiveSheet.Paste
Columns("A:d").Select Columns("A:d").EntireColumn.AutoFit
Sheets("sorted").Select
Application.CutCopyMode = False
Selection.AutoFilter Field:=4, Criteria1:="F"
Range("A2:d2").Select
Range(Selection, Selection.End(xlDown)).Select Selection.Copy
Sheets("Fees-Interest").Select Range("A2").Select ActiveSheet.Paste
Columns("A:d").Select Columns("A:d").EntireColumn.AutoFit
Sheets("sorted").Select
Application.CutCopyMode = False

End Sub

Any Help would be greatly appreciated!!
Click to expand...
 
D

Dave Peterson

I'm guessing that the code fails after the autofilter statements.

You can check to see how many visible rows are in the autofilter range with
something like:

With Worksheets("sheet1")
If .AutoFilter.Range.Columns(1).Cells _
.SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then
'only the header row showing.
'do nothing
Else
'your code to do the work
End If
End With
Hi,
Does anyone have any suggestions for the following:
I have a spreadsheet that looks at data and then sorts the data based
on certain text within the cell. The code works great when there are
several rows of data. However, when there is only 1 row of data or no
data for a particular day (This happens once or twice a month) the code
does not work.
Here is an example of the code:

Sub Test()

Range("D2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 =
"=IF(OR(ISNUMBER(SEARCH({""fee"",""inter""},RC[-1]))),""F"",IF(OR(ISNUMBER(SEARCH({""transf"",""direct
pay"",""xf""},RC[-1]))),""T"",""O""))"
Range("C2").Select
Selection.End(xlDown).Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "end"
Selection.End(xlUp).Select
Selection.Copy
Range("D3").Select
Range(Selection, Selection.End(xlDown)).Select ActiveSheet.Paste
Range("D2").Select Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False Selection.Copy Selection.PasteSpecial
Paste:=xlValues

Range("A1").Select

Sheets("Sorted").Select
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="T"
Range("A2:d2").Select
Range(Selection, Selection.End(xlDown)).Select Selection.Copy
Sheets("transfers").Select Range("A2").Select ActiveSheet.Paste
Columns("A:d").Select Columns("A:d").EntireColumn.AutoFit
Sheets("Sorted").Select
Application.CutCopyMode = False
Selection.AutoFilter Field:=4, Criteria1:="O"
Range("A2:d2").Select
Range(Selection, Selection.End(xlDown)).Select Selection.Copy
Sheets("other").Select Range("A2").Select ActiveSheet.Paste
Columns("A:d").Select Columns("A:d").EntireColumn.AutoFit
Sheets("sorted").Select
Application.CutCopyMode = False
Selection.AutoFilter Field:=4, Criteria1:="F"
Range("A2:d2").Select
Range(Selection, Selection.End(xlDown)).Select Selection.Copy
Sheets("Fees-Interest").Select Range("A2").Select ActiveSheet.Paste
Columns("A:d").Select Columns("A:d").EntireColumn.AutoFit
Sheets("sorted").Select
Application.CutCopyMode = False

End Sub

Any Help would be greatly appreciated!!
Click to expand...
 
T

Tom Ogilvy

Good thought. A lot of people seem to refer to filtering as sorting.

--
Regards,
Tom Ogilvy


Dave Peterson said:
I'm guessing that the code fails after the autofilter statements.

You can check to see how many visible rows are in the autofilter range with
something like:

With Worksheets("sheet1")
If .AutoFilter.Range.Columns(1).Cells _
.SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then
'only the header row showing.
'do nothing
Else
'your code to do the work
End If
End With
Hi,
Does anyone have any suggestions for the following:
I have a spreadsheet that looks at data and then sorts the data based
on certain text within the cell. The code works great when there are
several rows of data. However, when there is only 1 row of data or no
data for a particular day (This happens once or twice a month) the code
does not work.
Here is an example of the code:

Sub Test()

Range("D2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 =
Click to expand...
"=IF(OR(ISNUMBER(SEARCH({""fee"",""inter""},RC[-1]))),""F"",IF(OR(ISNUMBER(S
EARCH({""transf"",""direct
pay"",""xf""},RC[-1]))),""T"",""O""))"
Range("C2").Select
Selection.End(xlDown).Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "end"
Selection.End(xlUp).Select
Selection.Copy
Range("D3").Select
Range(Selection, Selection.End(xlDown)).Select ActiveSheet.Paste
Range("D2").Select Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False Selection.Copy Selection.PasteSpecial
Paste:=xlValues

Range("A1").Select

Sheets("Sorted").Select
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="T"
Range("A2:d2").Select
Range(Selection, Selection.End(xlDown)).Select Selection.Copy
Sheets("transfers").Select Range("A2").Select ActiveSheet.Paste
Columns("A:d").Select Columns("A:d").EntireColumn.AutoFit
Sheets("Sorted").Select
Application.CutCopyMode = False
Selection.AutoFilter Field:=4, Criteria1:="O"
Range("A2:d2").Select
Range(Selection, Selection.End(xlDown)).Select Selection.Copy
Sheets("other").Select Range("A2").Select ActiveSheet.Paste
Columns("A:d").Select Columns("A:d").EntireColumn.AutoFit
Sheets("sorted").Select
Application.CutCopyMode = False
Selection.AutoFilter Field:=4, Criteria1:="F"
Range("A2:d2").Select
Range(Selection, Selection.End(xlDown)).Select Selection.Copy
Sheets("Fees-Interest").Select Range("A2").Select ActiveSheet.Paste
Columns("A:d").Select Columns("A:d").EntireColumn.AutoFit
Sheets("sorted").Select
Application.CutCopyMode = False

End Sub

Any Help would be greatly appreciated!!
Click to expand...
http://www.excelforum.com/showthread.php?threadid=509401
Click to expand...
 
S

STEVEB

Thanks Dave & Tom,

I was able to get your suggestions to work! I really appreciate you
help!! You saved me a lot of time!!! Thanks Again!!

I was having one more issue related to this spreadsheet & was wonderin
if you had any suggestions:

I am having problems with my Code that sorts data based on differen
criteria and then posts that data(based on the sort) to various sheet
within the workbook. The code works great when there are three or mor
rows of data, however, if I have less than 3 rows of data the cod
either posts the data to the wrong sheet, double posts the data or doe
not post the data at all.

Is there a better way to sort the data? An example of my code is a
follows:

'This part of the Macro formats the current data.

Sheets("Download").Select
Range("A1").Select

Cells.Select
Selection.Copy
Sheets("Sorted").Select
Cells.Select
ActiveSheet.Paste
Range("A1").Select

Do While Len(Trim(Range("A1"))) = 0
Rows(1).Delete
Loop

Sheets("Download").Select
Range("A1").Select

Sheets("Sorted").Select

Columns("C:D").Select
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "Date"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Amount"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Description"
Range("A1:C1").Select
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("B:B").Select
Selection.Style = "Comma"
Columns("A:C").Select
Selection.AutoFormat Format:=xlRangeAutoFormatSimple, Number:=False
Font _
:=False, Alignment:=True, Border:=False, Pattern:=False, Width:=True

Range("A1").Select

'This part of the Macro sorts the data

Range("D2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(OR(ISNUMBER(SEARCH({""fee"",""inter""},R
[-1]))),""F"",IF(OR(ISNUMBER(SEARCH({""transf"",""dire c
pay"",""xf""},RC[-1]))),""T"",""O""))"
Range("C2").Select
Selection.End(xlDown).Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "end"
Selection.End(xlUp).Select
Selection.Copy
Range("D3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Range("D2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues

Range("A1").Select

Sheets("Sorted").Select
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="T"
Range("A2:d2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("transfers").Select
Range("A2").Select
ActiveSheet.Paste
Columns("A:d").Select
Columns("A:d").EntireColumn.AutoFit
Sheets("Sorted").Select
Application.CutCopyMode = False
Selection.AutoFilter Field:=4, Criteria1:="O"
Range("A2:d2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("other").Select
Range("A2").Select
ActiveSheet.Paste
Columns("A:d").Select
Columns("A:d").EntireColumn.AutoFit
Sheets("sorted").Select
Application.CutCopyMode = False
Selection.AutoFilter Field:=4, Criteria1:="F"
Range("A2:d2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Fees-Interest").Select
Range("A2").Select
ActiveSheet.Paste
Columns("A:d").Select
Columns("A:d").EntireColumn.AutoFit
Sheets("sorted").Select
Application.CutCopyMode = False

Sheets("transfers").Select

Range("A1").Select
ActiveCell.FormulaR1C1 = "Date"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Amount"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Description"
Range("A1:C1").Select
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Sheets("Fees-Interest").Select

Range("A1").Select
ActiveCell.FormulaR1C1 = "Date"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Amount"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Description"
Range("A1:C1").Select
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Sheets("Other").Select

Range("A1").Select
ActiveCell.FormulaR1C1 = "Date"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Amount"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Description"
Range("A1:C1").Select
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With


Thanks
 
D

Dave Peterson

Have you stepped through your code to find out where things break.
Thanks Dave & Tom,

I was able to get your suggestions to work! I really appreciate your
help!! You saved me a lot of time!!! Thanks Again!!

I was having one more issue related to this spreadsheet & was wondering
if you had any suggestions:

I am having problems with my Code that sorts data based on different
criteria and then posts that data(based on the sort) to various sheets
within the workbook. The code works great when there are three or more
rows of data, however, if I have less than 3 rows of data the code
either posts the data to the wrong sheet, double posts the data or does
not post the data at all.

Is there a better way to sort the data? An example of my code is as
follows:

'This part of the Macro formats the current data.

Sheets("Download").Select
Range("A1").Select

Cells.Select
Selection.Copy
Sheets("Sorted").Select
Cells.Select
ActiveSheet.Paste
Range("A1").Select

Do While Len(Trim(Range("A1"))) = 0
Rows(1).Delete
Loop

Sheets("Download").Select
Range("A1").Select

Sheets("Sorted").Select

Columns("C:D").Select
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "Date"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Amount"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Description"
Range("A1:C1").Select
Selection.Font.Bold = True
With Selection
HorizontalAlignment = xlCenter
VerticalAlignment = xlBottom
WrapText = False
Orientation = 0
AddIndent = False
IndentLevel = 0
ShrinkToFit = False
ReadingOrder = xlContext
MergeCells = False
End With
Columns("B:B").Select
Selection.Style = "Comma"
Columns("A:C").Select
Selection.AutoFormat Format:=xlRangeAutoFormatSimple, Number:=False,
Font _
:=False, Alignment:=True, Border:=False, Pattern:=False, Width:=True

Range("A1").Select

'This part of the Macro sorts the data

Range("D2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IF(OR(ISNUMBER(SEARCH({""fee"",""inter""},RC
[-1]))),""F"",IF(OR(ISNUMBER(SEARCH({""transf"",""dire ct
pay"",""xf""},RC[-1]))),""T"",""O""))"
Range("C2").Select
Selection.End(xlDown).Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "end"
Selection.End(xlUp).Select
Selection.Copy
Range("D3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Range("D2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlValues

Range("A1").Select

Sheets("Sorted").Select
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="T"
Range("A2:d2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("transfers").Select
Range("A2").Select
ActiveSheet.Paste
Columns("A:d").Select
Columns("A:d").EntireColumn.AutoFit
Sheets("Sorted").Select
Application.CutCopyMode = False
Selection.AutoFilter Field:=4, Criteria1:="O"
Range("A2:d2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("other").Select
Range("A2").Select
ActiveSheet.Paste
Columns("A:d").Select
Columns("A:d").EntireColumn.AutoFit
Sheets("sorted").Select
Application.CutCopyMode = False
Selection.AutoFilter Field:=4, Criteria1:="F"
Range("A2:d2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Fees-Interest").Select
Range("A2").Select
ActiveSheet.Paste
Columns("A:d").Select
Columns("A:d").EntireColumn.AutoFit
Sheets("sorted").Select
Application.CutCopyMode = False

Sheets("transfers").Select

Range("A1").Select
ActiveCell.FormulaR1C1 = "Date"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Amount"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Description"
Range("A1:C1").Select
Selection.Font.Bold = True
With Selection
HorizontalAlignment = xlCenter
VerticalAlignment = xlBottom
WrapText = False
Orientation = 0
AddIndent = False
IndentLevel = 0
ShrinkToFit = False
ReadingOrder = xlContext
MergeCells = False
End With

Sheets("Fees-Interest").Select

Range("A1").Select
ActiveCell.FormulaR1C1 = "Date"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Amount"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Description"
Range("A1:C1").Select
Selection.Font.Bold = True
With Selection
HorizontalAlignment = xlCenter
VerticalAlignment = xlBottom
WrapText = False
Orientation = 0
AddIndent = False
IndentLevel = 0
ShrinkToFit = False
ReadingOrder = xlContext
MergeCells = False
End With

Sheets("Other").Select

Range("A1").Select
ActiveCell.FormulaR1C1 = "Date"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Amount"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Description"
Range("A1:C1").Select
Selection.Font.Bold = True
With Selection
HorizontalAlignment = xlCenter
VerticalAlignment = xlBottom
WrapText = False
Orientation = 0
AddIndent = False
IndentLevel = 0
ShrinkToFit = False
ReadingOrder = xlContext
MergeCells = False
End With

Thanks
Click to expand...
 
S

STEVEB

Thanks for getting back to me Dave, I appreciate it!

What is strange about this is if there are 3 or more lines the code
works great..no problems. If there are less than three lines the code
does not break..it just sorts things incorrectly. For example:

The first part of the code looks at the text and assigns either a T,F
or O in column D in the sheet named "Sorted" . Based on the sort the
code copies info to either a sheet named "Transfer"(For all T's),
"Fees" (For all F's) and "Other" (For all O's). However, when there is
less than three lines the code will always want to put one line in the
"Transfers" sheet even if there are no "T"s and then in the correct
sheet. This does not happen when there are 3 or more lines, if there
are no "T's" none will be posted.

I hope this helps, it is probably a bit confusing..so if you need more
detail, please let me know.

Thanks
 
D

Dave Peterson

Well, there's lots of code in that there procedure.

And lots of selects. I find it very difficult to see what's going on.

Maybe a bit of a rewrite would make it easier to understand (well, for me, it
would).

I _think_ that this does the same thing as your code--I didn't test it, but it
did compile ok.

Option Explicit
Sub testme()

Dim DLWks As Worksheet
Dim SortedWks As Worksheet
Dim LastRow As Long
Dim RngToCopy As Range

Dim CharsToFilter As Variant
Dim SheetsToPaste As Variant
Dim iCtr As Long

Set DLWks = Worksheets("Download")
Set SortedWks = Worksheets("Sorted")

'"Transfer"(For all T's),
'"Fees" (For all F's) 'or Fees-Interest????
'"Other" (For all O's).

CharsToFilter = Array("T", "F", "O")
SheetsToPaste = Array("Transfer", "Fees-Interest", "Other")

DLWks.Cells.Copy _
Destination:=SortedWks.Range("a1")

With SortedWks
Do While Len(Trim(.Range("A1"))) = 0
.Rows(1).Delete
Loop
.Columns("C:D").Delete
.Rows("1:1").Insert
.Range("A1").Value = "Date"
.Range("B1").Value = "Amount"
.Range("C1").Value = "Description"
With .Range("a1:c1")
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.Columns("B:B").Style = "Comma"
.Columns("a:C").AutoFormat Format:=xlRangeAutoFormatSimple, _
Number:=False, Font:=False, Alignment:=True, _
Border:=False, Pattern:=False, Width:=True
.UsedRange.Columns.AutoFit

LastRow = .Range("C2").End(xlDown).Row

With .Range("D2:D" & LastRow)
.FormulaR1C1 _
= "=IF(OR(ISNUMBER(SEARCH({""fee"",""inter""},RC[-1])))," _
& """F"",IF(OR(ISNUMBER(SEARCH({""transf""," _
& """dire ctpay"",""xf""},RC[-1]))),""T"",""O""))"
.Value = .Value
End With

For iCtr = LBound(CharsToFilter) To UBound(CharsToFilter)
.AutoFilterMode = False

.Range("a1").CurrentRegion.AutoFilter Field:=4, _
Criteria1:=CharsToFilter(iCtr)

If .AutoFilter.Range.Columns(1).Cells _
.SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then
'only the header row showing.
'do nothing
Else
With .AutoFilter.Range
Set RngToCopy = .Resize(.Rows.Count - 1, 4).Offset(1, 0) _
.Cells.SpecialCells(xlCellTypeVisible)
End With

'clear out existing data???
Worksheets(SheetsToPaste(iCtr)).Cells.Clear

RngToCopy.Copy _
Destination:=Worksheets(SheetsToPaste(iCtr)).Range("a2")

With Worksheets(SheetsToPaste(iCtr))
.Range("A1").Value = "Date"
.Range("B1").Value = "Amount"
.Range("C1").Value = "Description"
With .Range("a1:c1")
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.UsedRange.Columns.AutoFit
End With
End If
Next iCtr
.AutoFilterMode = False
End With
End Sub
 
S

STEVEB

Thanks so much for your help Dave, I really appreciate it! It seems
like we are very close!!!

I agree, your code is a lot less confusing. At this point the code is
able to post the information from the "download" sheet to the "sorted"
sheet. After that I recieve the following error:

Run time error 1004 - Application-defined or object defined error.

At this point:

..FormulaR1C1 _
= "=IF(OR(ISNUMBER(SEARCH({""fee"",""inter""},RC [-1])))," _
& """F"",IF(OR(ISNUMBER(SEARCH({""transf""," _
& """dire ctpay"",""xf""},RC[-1]))),""T"",""O""))"

What I am missing? Thanks so much for your help!!
 
D

Dave Peterson

I don't know.

I put that little portion into a test sub:

Option Explicit
Sub testme()

Dim LastRow As Long
LastRow = 13

With ActiveSheet
With .Range("D2:D" & LastRow)
.FormulaR1C1 _
= "=IF(OR(ISNUMBER(SEARCH({""fee"",""inter""},RC[-1])))," _
& """F"",IF(OR(ISNUMBER(SEARCH({""transf""," _
& """dire ctpay"",""xf""},RC[-1]))),""T"",""O""))"
'.Value = .Value
End With
End With

End Sub

(Notice the ".value = .value" is commented out.)

And the formula worked nicely.

What's lastrow equal to when you get to that line?

Thanks so much for your help Dave, I really appreciate it! It seems
like we are very close!!!

I agree, your code is a lot less confusing. At this point the code is
able to post the information from the "download" sheet to the "sorted"
sheet. After that I recieve the following error:

Run time error 1004 - Application-defined or object defined error.

At this point:

FormulaR1C1 _
= "=IF(OR(ISNUMBER(SEARCH({""fee"",""inter""},RC [-1])))," _
& """F"",IF(OR(ISNUMBER(SEARCH({""transf""," _
& """dire ctpay"",""xf""},RC[-1]))),""T"",""O""))"

What I am missing? Thanks so much for your help!!
Click to expand...
 
S

STEVEB

Thanks Dave! Your suggestion worked. Getting close

Moving down the Code.....The code now puts either a "T", "F" or "O" in
column D on the "Sorted" Sheet.

It is just not posting all the "T's" on the transfer sheet, the "O's"
on the Other Sheet, etc.

I am receiving the following error:

Run-time error '9' - subscript out of range

At this line:

Worksheets(SheetsToPaste(iCtr)).Cells.Clear

What am I missing this time? I really appreciate your help!! Thanks
again!
 
D

Dave Peterson

Subscript out of range probably means that the worksheet names that I used don't
exist in your workbook.

In one of your messages, you used Fees. In your code, you used Fees-Interest.

I must have guessed incorrectly.

Fix this area:

CharsToFilter = Array("T", "F", "O")
SheetsToPaste = Array("Transfer", "Fees-Interest", "Other")

Order is very important!
 
S

STEVEB

Dave,

That was the trick!!! I tested the code several times & it worked
great!!! Thanks so much for your time, I really appreciate your help!!
 
D

Dave Peterson

Glad you got it working.

Dave,

That was the trick!!! I tested the code several times & it worked
great!!! Thanks so much for your time, I really appreciate your help!!
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Sort to Various Sheets in Workbook 1
ACTIVESHEET.PASTE not working. 3
macro working very slow 1
How can I make this simpler? 3
VBA: Copy from columns on multiple worksheets 0
Find/replace macro 1
Summing columns after insert rows 2
VBA Code runs out of memory - too much copy/paste? 0

Top