Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default A tricky macro -


Hi guys


I do believe I will need help by real experts on this one.


Im going through reports to find if there is any credits(Column A) and
debits(Column B) which counter eachother off.

i.e. Credit of 1000 will counter off a Debit of 1000

However the tricky part is that, several Credits can counter off a
Debit or the other way around.

i.e Credit of 200 + a credit of 300 + a credit of 500 = 1000
can counter off a debit of 1000

When the macro finds a match, I want it to copy the rows and past them
in order in another sheet. Take the example above as an example, there
will be 3 rows (credit) and 1 row from(debit).

Then delete these in ActiveSheet.



Is this possible.. ?


--
Ctech
------------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=501125

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,441
Default A tricky macro -

Ctech,

There is code available that could be used to solve this, but how well it would work depends on how
many debits and credits you have. If you have other identifying data to narrow down which credits
can be applied to which debits, that would help to reduce the size of the problem.

Also, you would be amazed at the number of combinations that can be used to make up a specific
number from a fairly small data set, so it is unlikely that you will be able to find unique
solutions anyway. A recent post had a list of 24 numbers, and four combinations added up the
specific number the OP had in mind.....

HTH,
Bernie
MS Excel MVP


"Ctech" wrote in message
...

Hi guys


I do believe I will need help by real experts on this one.


Im going through reports to find if there is any credits(Column A) and
debits(Column B) which counter eachother off.

i.e. Credit of 1000 will counter off a Debit of 1000

However the tricky part is that, several Credits can counter off a
Debit or the other way around.

i.e Credit of 200 + a credit of 300 + a credit of 500 = 1000
can counter off a debit of 1000

When the macro finds a match, I want it to copy the rows and past them
in order in another sheet. Take the example above as an example, there
will be 3 rows (credit) and 1 row from(debit).

Then delete these in ActiveSheet.



Is this possible.. ?


--
Ctech
------------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=501125



  #3   Report Post  
Posted to microsoft.public.excel.programming
GB GB is offline
external usenet poster
 
Posts: 230
Default A tricky macro -

Possible yes... Not quite as tricky as you may think. you need to keep
track of the list of unique Items (say account XXX) and Sum all values
related to Account XXX provided that summing a debit is adding a negative
number to the total of Account XXX. If after all data has been accumulated
and you go through the totals, if an account is offset, you would copy all
the rows that were used to create the sum and then delete all the applicable
rows. If you set up a class module, you can do this. Your class module to
track all of the data for the accounts. Basically you would create an array
of the class module so that you could reference/review each accoun. The
class module would contain a list (array) of the rows in which that account
is found, and the sum of the balance on that account. Now in the class
module you would also want some helper information, like number of rows for
account, and get total of the account.

Now, the hard part... at least to remember, is that because the row would be
stored as a number, when you go to delete the row(s) you must start from the
end of your list and work your way to the beginning. You almost need to also
create a separate sorted list of all the rows that will be deleted after you
have collected all of your offset data. Then start at the back of the list
and delete each row (provided that the last row is added to the end of the
data.) A fast way to create this list, would be to insert into a worksheet
each row number, then sort the list, and populate an array, or just use the
list to delete each row.

I've provided "pseudocode" the next thing is to implement/program. Think
you can handle that? If not, maybe I or someone else can help.

"Ctech" wrote:


Hi guys


I do believe I will need help by real experts on this one.


Im going through reports to find if there is any credits(Column A) and
debits(Column B) which counter eachother off.

i.e. Credit of 1000 will counter off a Debit of 1000

However the tricky part is that, several Credits can counter off a
Debit or the other way around.

i.e Credit of 200 + a credit of 300 + a credit of 500 = 1000
can counter off a debit of 1000

When the macro finds a match, I want it to copy the rows and past them
in order in another sheet. Take the example above as an example, there
will be 3 rows (credit) and 1 row from(debit).

Then delete these in ActiveSheet.



Is this possible.. ?


--
Ctech
------------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=501125


  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default A tricky macro -


My VBA skills are becoming quite good, and Im using it extensivly at
work. But I have to say that most of what you two are talking about
sounds difficult...

I haven't used arrayes or class module before, etc etc...

would any of you kind of show a start of a code so I get guided on the
right track.... then Ill work on it a bit myself and come back with my
results and problems later...

Remember there are negative numbers too


--
Ctech
------------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=501125

  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default A tricky macro -


Can anyone give me a helping hand on this matter?


--
Ctech
------------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=501125



  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,441
Default A tricky macro -

Here's the code, follow the instructions, and run FindSums.

HTH,
Bernie
MS Excel MVP


Option Explicit
'This *REQUIRES* VBAProject references to
'Microsoft Scripting Runtime
'Microsoft VBScript Regular Expressions 1.0
'Written by Harlan Grove

Sub FindSums()
Const TOL As Double = 0.000001 'modify as needed
Dim c As Variant


Dim j As Long, k As Long, n As Long, p As Boolean
Dim s As String, t As Double, u As Double
Dim v As Variant, x As Variant, y As Variant
Dim dc1 As New Dictionary, dc2 As New Dictionary
Dim dcn As Dictionary, dco As Dictionary
Dim re As New RegExp


re.Global = True
re.IgnoreCase = True


On Error Resume Next


Set x = Application.InputBox( _
Prompt:="Enter range of values:", _
Title:="findsums", _
Default:="", _
Type:=8 _
)


If x Is Nothing Then
Err.Clear
Exit Sub
End If


y = Application.InputBox( _
Prompt:="Enter target value:", _
Title:="findsums", _
Default:="", _
Type:=1 _
)


If VarType(y) = vbBoolean Then
Exit Sub
Else
t = y
End If


On Error GoTo 0


Set dco = dc1
Set dcn = dc2


Call recsoln


For Each y In x.Value2
If VarType(y) = vbDouble Then
If Abs(t - y) < TOL Then
recsoln "+" & Format(y)


ElseIf dco.Exists(y) Then
dco(y) = dco(y) + 1


ElseIf y < t - TOL Then
dco.Add Key:=y, Item:=1


c = CDec(c + 1)
Application.StatusBar = "[1] " & Format(c)


End If


End If
Next y


n = dco.Count


ReDim v(1 To n, 1 To 3)


For k = 1 To n
v(k, 1) = dco.Keys(k - 1)
v(k, 2) = dco.Items(k - 1)
Next k


qsortd v, 1, n


For k = n To 1 Step -1
v(k, 3) = v(k, 1) * v(k, 2) + v(IIf(k = n, n, k + 1), 3)
If v(k, 3) t Then dcn.Add Key:="+" & Format(v(k, 1)), Item:=v(k, 1)
Next k


On Error GoTo CleanUp
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


For k = 2 To n
dco.RemoveAll
swapo dco, dcn


For Each y In dco.Keys
p = False


For j = 1 To n
If v(j, 3) < t - dco(y) - TOL Then Exit For


x = v(j, 1)
s = "+" & Format(x)
If Right(y, Len(s)) = s Then p = True


If p Then
re.Pattern = "\" & s & "(?=(\+|$))"
If re.Execute(y).Count < v(j, 2) Then
u = dco(y) + x


If Abs(t - u) < TOL Then
recsoln y & s


ElseIf u < t - TOL Then
dcn.Add Key:=y & s, Item:=u


c = CDec(c + 1)
Application.StatusBar = "[" & Format(k) & "] " & Format(c)


End If
End If
End If
Next j
Next y


If dcn.Count = 0 Then Exit For
Next k


If (recsoln() = 0) Then _
MsgBox Prompt:="all combinations exhausted", Title:="No Solution"


CleanUp:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = False


End Sub


Private Function recsoln(Optional s As String)
Const OUTPUTWSN As String = "findsums solutions" 'modify to taste


Static r As Range
Dim ws As Worksheet


If s = "" And r Is Nothing Then
On Error Resume Next
Set ws = ActiveWorkbook.Worksheets(OUTPUTWSN)


If ws Is Nothing Then
Err.Clear
Application.ScreenUpdating = False
Set ws = ActiveSheet
Set r = Worksheets.Add.Range("A1")
r.Parent.Name = OUTPUTWSN
ws.Activate
Application.ScreenUpdating = False


Else
ws.Cells.Clear
Set r = ws.Range("A1")


End If


recsoln = 0


ElseIf s = "" Then
recsoln = r.Row - 1
Set r = Nothing


Else
r.Value = s
Set r = r.Offset(1, 0)
recsoln = r.Row - 1


End If


End Function


Private Sub qsortd(v As Variant, lft As Long, rgt As Long)
'ad hoc quicksort subroutine
'translated from Aho, Weinberger & Kernighan,
'"The Awk Programming Language", page 161


Dim j As Long, pvt As Long


If (lft = rgt) Then Exit Sub


swap2 v, lft, lft + Int((rgt - lft + 1) * Rnd)


pvt = lft


For j = lft + 1 To rgt
If v(j, 1) v(lft, 1) Then
pvt = pvt + 1
swap2 v, pvt, j
End If
Next j


swap2 v, lft, pvt


qsortd v, lft, pvt - 1
qsortd v, pvt + 1, rgt
End Sub


Private Sub swap2(v As Variant, i As Long, j As Long)
'modified version of the swap procedure from
'translated from Aho, Weinberger & Kernighan,
'"The Awk Programming Language", page 161


Dim t As Variant, k As Long


For k = LBound(v, 2) To UBound(v, 2)
t = v(i, k)
v(i, k) = v(j, k)
v(j, k) = t
Next k
End Sub


Private Sub swapo(a As Object, b As Object)
Dim t As Object


Set t = a
Set a = b
Set b = t
End Sub
'---- end VBA code ----

"Ctech" wrote in
message ...

Can anyone give me a helping hand on this matter?


--
Ctech
------------------------------------------------------------------------
Ctech's Profile:
http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=501125



  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default A tricky macro -


I get an error when I run it, is says that "New dictionary" is not
recogniesed.

Does this have to do with this:

'This *REQUIRES* VBAProject references to
'Microsoft Scripting Runtime
'Microsoft VBScript Regular Expressions 1.0
'Written by Harlan Grove


Bernie Deitrick: Did you write this macro now just for me?


--
Ctech
------------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=501125

  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 35,218
Default A tricky macro -

Yep.

Click on tools|references and select those that Harlan/Bernie indicated.

Ctech wrote:

I get an error when I run it, is says that "New dictionary" is not
recogniesed.

Does this have to do with this:

'This *REQUIRES* VBAProject references to
'Microsoft Scripting Runtime
'Microsoft VBScript Regular Expressions 1.0
'Written by Harlan Grove

Bernie Deitrick: Did you write this macro now just for me?

--
Ctech
------------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=501125


--

Dave Peterson
  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default A tricky macro -


Hi


I can now run this macro... thank you to Dave Peterson..

But I don't understand what this macro actually does.. Can someone
explaine a bit more in detail. Thanks


--
Ctech
------------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=501125

  #10   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,441
Default A tricky macro -

Ctech,

Only Harlan _really_ understands it... the rest of us just use it to get
results. ;-)

Basically, it sorts the values, then picks different values to try to add
together to get to the total. If it overshoots, it goes back and tries other
combinations, by deleting one or more values from the possibilities, to
allow other values to be tried. If you want to see how it works, step
through the macro (using F8) and input three values 1, 2, and 3, and ask
that the total it finds be 5.

Bernie


"Ctech" wrote in
message ...

Hi


I can now run this macro... thank you to Dave Peterson..

But I don't understand what this macro actually does.. Can someone
explaine a bit more in detail. Thanks


--
Ctech
------------------------------------------------------------------------
Ctech's Profile:
http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=501125





  #11   Report Post  
Posted to microsoft.public.excel.programming
GB GB is offline
external usenet poster
 
Posts: 230
Default A tricky macro -

This sounds like it's beyond what he's trying to do. I thought what he was
trying to do, was that if all items exactly offset each other then get rid of
them, not just minimize the list to the best possible.

Did I misunderstand the original question/intent?
(I realize it had to do with financial matters, and credits and debits don't
always equal 0 as much as we would like them to. :) )


"Bernie Deitrick" wrote:

Ctech,

Only Harlan _really_ understands it... the rest of us just use it to get
results. ;-)

Basically, it sorts the values, then picks different values to try to add
together to get to the total. If it overshoots, it goes back and tries other
combinations, by deleting one or more values from the possibilities, to
allow other values to be tried. If you want to see how it works, step
through the macro (using F8) and input three values 1, 2, and 3, and ask
that the total it finds be 5.

Bernie


"Ctech" wrote in
message ...

Hi


I can now run this macro... thank you to Dave Peterson..

But I don't understand what this macro actually does.. Can someone
explaine a bit more in detail. Thanks


--
Ctech
------------------------------------------------------------------------
Ctech's Profile:
http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=501125




  #12   Report Post  
Posted to microsoft.public.excel.programming
GB GB is offline
external usenet poster
 
Posts: 230
Default A tricky macro -

Let me know here by starting a new thread off of my earlier post if you are
still interested in learning about Class Modules and/or Arrays. Looks like
you are well on your way to what you want, based on all of the feedback that
has been provided. And don't worry I take rejection just fine. :)

"Ctech" wrote:


My VBA skills are becoming quite good, and Im using it extensivly at
work. But I have to say that most of what you two are talking about
sounds difficult...

I haven't used arrayes or class module before, etc etc...

would any of you kind of show a start of a code so I get guided on the
right track.... then Ill work on it a bit myself and come back with my
results and problems later...

Remember there are negative numbers too


--
Ctech
------------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=501125


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Tricky Macro Question Philip Excel Worksheet Functions 4 December 30th 09 05:40 PM
Tricky Macro teddy0bear Excel Discussion (Misc queries) 1 January 6th 07 10:39 AM
tricky macro cjupiter Excel Discussion (Misc queries) 0 February 9th 06 01:38 PM
Tricky... Macro Security! rci Excel Programming 1 January 29th 05 11:12 PM
Macro assistance (might be tricky) Sean[_7_] Excel Programming 0 May 21st 04 04:40 PM


All times are GMT +1. The time now is 02:43 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"