Code Modification

Try this...

Sub Cash()
Dim WS As Worksheet
Dim WSCash As Worksheet
Dim WSL As Worksheet
Dim MaxRow As Long, I As Long, MaxRowC As Long, lCount As Long

'---> Diable Events
With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

'---> Set Variables
Set WS = Sheets("Single Entry")
Set WSCash = Sheets("Cash")
Set WSL = Sheets("LogFile")
MaxRow = WS.Range("A" & WS.Rows.Count).End(xlUp).Row
MaxRowC = WSCash.Range("A" & WSCash.Rows.Count).End(xlUp).Row + 1

With WS.Rows(1)
   .AutoFilter field:=4, Criteria1:="Cash"
   If WS.Range("A1:A" & MaxRow).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
      WS.Range("A2:H" & MaxRow).SpecialCells(xlCellTypeVisible).Copy WSL.Range("A2")
   End If
   .AutoFilter
End With
For I = 2 To MaxRow
    If LCase(WS.Cells(I, "D")) = "cash" Then
        If WS.Cells(I, "B") <> "" Then
            WSCash.Cells(MaxRowC, "A") = WS.Cells(I, "B")
        Else
            WSCash.Cells(MaxRowC, "A") = WS.Cells(I, "A")
        End If
        WSCash.Cells(MaxRowC, "B") = WS.Cells(I, "E")
        WSCash.Cells(MaxRowC, "C") = WS.Cells(I, "H")
        MaxRowC = MaxRowC + 1
        lCount = lCount + 1
    End If
Next I

WSCash.UsedRange.Sort Key1:=WSCash.Range("B1"), order1:=xlAscending, Header:=xlYes

MsgBox "A total of " & lCount & " Cash Items were copied to sheet Cash.", vbInformation, "Cash Transfer"

'---> Enable Events
With Application
    .EnableEvents = True
    .ScreenUpdating = True
    .DisplayAlerts = True
End With

End Sub

ASKER

Code Seems working - it post entries to sheet Cash as well as to sheet LogFile but - last step is missing ...i.e. it wont remove cash entries from sheet Single Entry Sheet without affecting formulas in column L & onward.

Thanks

Just add one line of code after line#36

WS.Rows(I).Delete

ASKER

i did but it transfer only 3 entries of cash instead of 4 i.e. Logfile sheet all 4 ...cash sheet 3 entries and removal 3 entries ...

Sub Cash()
Dim WS As Worksheet
Dim WSCash As Worksheet
Dim WSL As Worksheet
Dim MaxRow As Long, I As Long, MaxRowC As Long, lCount As Long

'---> Diable Events
With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

'---> Set Variables
Set WS = Sheets("Single Entry")
Set WSCash = Sheets("Cash")
Set WSL = Sheets("LogFile")
MaxRow = WS.Range("A" & WS.Rows.Count).End(xlUp).Row
MaxRowC = WSCash.Range("A" & WSCash.Rows.Count).End(xlUp).Row + 1

With WS.Rows(1)
   .AutoFilter field:=4, Criteria1:="Cash"
   If WS.Range("A1:A" & MaxRow).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
      WS.Range("A2:H" & MaxRow).SpecialCells(xlCellTypeVisible).Copy WSL.Range("A2")
   End If
   .AutoFilter
End With
For I = 2 To MaxRow
    If LCase(WS.Cells(I, "D")) = "cash" Then
        If WS.Cells(I, "B") <> "" Then
            WSCash.Cells(MaxRowC, "A") = WS.Cells(I, "B")
        Else
            WSCash.Cells(MaxRowC, "A") = WS.Cells(I, "A")
        End If
        WSCash.Cells(MaxRowC, "B") = WS.Cells(I, "E")
        WSCash.Cells(MaxRowC, "C") = WS.Cells(I, "H")
        WS.Rows(I).Delete
        MaxRowC = MaxRowC + 1
        lCount = lCount + 1
    End If
Next I

WSCash.UsedRange.Sort Key1:=WSCash.Range("B1"), order1:=xlAscending, Header:=xlYes

MsgBox "A total of " & lCount & " Cash Items were copied to sheet Cash.", vbInformation, "Cash Transfer"

'---> Enable Events
With Application
    .EnableEvents = True
    .ScreenUpdating = True
    .DisplayAlerts = True
End With

End Sub

Thanks

My bad. I forgot to tell you that you will have to loop in reverse order like this....

For I = MaxRow To 2 Step -1

ASKER

Neeraj will you please provide me full code?

Thanks

ASKER CERTIFIED SOLUTION

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ASKER

May i ask FollowUp but this one is bit complex....?

Thanks

It depends If I am available to answer it.
Maybe you should open a new question along with a reference to this question so that other experts would also be able to help you.

ASKER

Neeraj Ji

Same Problem if there is only one cash entry in last row then it wont work.

See Attached
Portfolio-V06.xlsm

ASKER

New Question Posted.i dint link with this thread because it is different process then this question.

Thanks

That is because you are finding the last row in column A. Change the line to find the last row to this.....

MaxRow = WS.Range("D" & WS.Rows.Count).End(xlUp).Row

ASKER

Cash entry either remain on column A or B so above solution will taken care of both type of cases ?