Solved

Code Modification

Posted on 2016-08-24
14
55 Views
Last Modified: 2016-08-25
Hi Experts,

Need A Help In Modifying Existing Macro In Attached WB..Please Help..
In Attached WB - Module - SingleToPost - Sub Cash ()....it Post Entries To Sheet Cash From sheet Single Entry - I need further more in this existing Sub ....it Post Exact Entry in Sheet LogFile & Then Remove Those Entries From Sheet Single Entry Without Affecting Formula in column  L to P.Existing Macro WillDone its jobNeed Further More StepsSteps without affecting Formulas
See Attached

Thanks
Portfolio-V06.xlsm
0
Comment
Question by:itjockey
  • 8
  • 6
14 Comments
 
LVL 29

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41769931
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

Open in new window

0
 
LVL 8

Author Comment

by:itjockey
ID: 41770168
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
0
 
LVL 29

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41770615
Just add one line of code after line#36
WS.Rows(I).Delete

Open in new window

0
Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

 
LVL 8

Author Comment

by:itjockey
ID: 41770633
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

Open in new window

Thanks
0
 
LVL 29

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41770648
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

Open in new window

0
 
LVL 8

Author Comment

by:itjockey
ID: 41770652
Neeraj will you please provide me full code?

Thanks
0
 
LVL 29

Accepted Solution

by:
Subodh Tiwari (Neeraj) earned 500 total points
ID: 41770659
Okay here it is......
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 = MaxRow To 2 Step -1
    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.Range("A" & I & ":H" & I).Delete shift:=xlUp
        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

Open in new window

0
 
LVL 8

Author Closing Comment

by:itjockey
ID: 41770667
May i ask FollowUp but this one is bit complex....?

Thanks
0
 
LVL 29

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41770672
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.
0
 
LVL 8

Author Comment

by:itjockey
ID: 41770731
Neeraj Ji

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

See Attached
Portfolio-V06.xlsm
0
 
LVL 8

Author Comment

by:itjockey
ID: 41770738
New Question Posted.i dint link with this thread because it is different process then this question.

Thanks
0
 
LVL 29

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41770739
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
0
 
LVL 8

Author Comment

by:itjockey
ID: 41770752
Cash entry either remain on column A or B so above solution will taken care of both type of cases ?
0
 
LVL 8

Author Comment

by:itjockey
ID: 41770872
ok Done it is working ...posted new question regarding this question please look in to this.

Thanks
0

Featured Post

Gigs: Get Your Project Delivered by an Expert

Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

0. Preface This Article is a replacement of http:/A_1788-Getting-your-EE-Ranking-statistics-in-Excel.html (http://http:/A_1788-Getting-your-EE-Ranking-statistics-in-Excel.html). Changes in the way Experts Exchange delivers point statistics, impleme…
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
This Micro Tutorial will give you a basic overview how to record your screen with Microsoft Expression Encoder. This program is still free and open for the public to download. This will be demonstrated using Microsoft Expression Encoder 4.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

806 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question