Solved

Code Modification

Posted on 2016-08-24
14
58 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
[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 30

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 30

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: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

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: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 30

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 30

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 30

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 30

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

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

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

The code described here does no longer work. Please see replacement Article: http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/A_3887-Getting-your-EE-Ranking-statistics-in-Excel-The-Next-Generation.html (http…
Being an active EE Expert means to get a lot of (E)EMail, as you certainly know. If you are using Outlook, I'll show you how to minimize your inbox contents without losing anything – even improve the experience by changing the Subject line to facili…
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…

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