Solved

Code Modification

Posted on 2016-08-24
14
60 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:Naresh Patel
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 8
  • 6
14 Comments
 
LVL 31

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:Naresh Patel
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 31

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
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 8

Author Comment

by:Naresh Patel
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 31

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:Naresh Patel
ID: 41770652
Neeraj will you please provide me full code?

Thanks
0
 
LVL 31

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:Naresh Patel
ID: 41770667
May i ask FollowUp but this one is bit complex....?

Thanks
0
 
LVL 31

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:Naresh Patel
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:Naresh Patel
ID: 41770738
New Question Posted.i dint link with this thread because it is different process then this question.

Thanks
0
 
LVL 31

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:Naresh Patel
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:Naresh Patel
ID: 41770872
ok Done it is working ...posted new question regarding this question please look in to this.

Thanks
0

Featured Post

[Webinar] Learn How Hackers Steal Your Credentials

Do You Know How Hackers Steal Your Credentials? Join us and Skyport Systems to learn how hackers steal your credentials and why Active Directory must be secure to stop them. Thursday, July 13, 2017 10:00 A.M. PDT

Question has a verified solution.

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

Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
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…
If you're a developer or IT admin, you’re probably tasked with managing multiple websites, servers, applications, and levels of security on a daily basis. While this can be extremely time consuming, it can also be frustrating when systems aren't wor…

726 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