Google Answers Logo
View Question
 
Q: Excel Macro-match cutomer data ( No Answer,   4 Comments )
Question  
Subject: Excel Macro-match cutomer data
Category: Computers > Programming
Asked by: jpcp1-ga
List Price: $50.00
Posted: 10 Feb 2005 08:47 PST
Expires: 12 Mar 2005 08:47 PST
Question ID: 472354
I receive an Excel File which contains account data for all our
customers.  Customer A report amount with C & D.  Customer B reports
with A & C etc.  I need to match each customer reported amounts
against what each other customer reported and produce a report.  The
rub is the report for customer A would show amounts with B,C & D; even
though A did not report and amount with B.
(Is this an Inner & OuterJoin my brain hurts from thinking about this
one sorting the file creating two files in reverse.....)

The file (excel XP 2002 ver.) can contain any number of customer
combinations and varies each month.   The file has CustNmme for one of
two G/L account 0121 or 0122 the Customer they have the account with
(Acctwith) and the outstanding amount.  Below are samples.  I also
have MS Query also installed.  If subtotals can be added on changes to
CustName and GLAcct would be extra beneficials $$.


Excel DATA FILE (Small Sample)

A          B        C       D
CustName GLAcct	AcctWith Amount 
B	 0121	  F 	 12,300,000 
B	 0121	  U	 16,494,419 
B	 0122	  D 	     18,689 
B	 0122	  F	 (1,843,257)
B	 0122	  G	     75,217 
F 	 0121	  B	(12,000,000)
F 	 0122	  B	  1,500,000 
G	 0121	  F	    450,000 
G	 0122	  B	     75,000 
G	 0122	  F	    250,000 
G	 0122	  U	    444,444 
U	 0121	  B 	(16,494,419)
U	 0122	  B	     44,123 
U	 0122	  G	   (400,000)


Excel REPORT (Sample)
 A         B       C         D             E              F
CustName GLAcct	AcctWith  Amount	Match Amt	Diff
B	 0121	F 	 12,300,000 	 (12,000,000)	 300,000 
B	 0121	U 	 16,494,419 	 (16,494,419)	 -   
B	 0122	D 	     18,689 	 -   	          18,689 
B	 0122	F	 (1,843,257)	   1,500,000 	(343,257)
B	 0122	G	     75,217 	      75,000 	 150,217 
B	 0122	U	 -   	              44,123 	  44,123 
D	 0122	B	 -   	              18,689 	  18,689 
F	 0121	G	 -   	             450,000 	 450,000 
F	 0122	B	  1,500,000 	  (1,843,257)	(343,257)
F	 0122	G	 -   	             250,000 	 250,000 
F 	 0121	B 	(12,000,000)	  12,300,000 	 300,000 
G	 0122	B	     75,000 	      75,217 	 150,217 
G	 0122	F	    250,000 	 -   	         250,000 
G	 0122	U	    444,444 	    (400,000)	  44,444 
G 	 0121	F	    450,000 	 -   	         450,000 
U	 0121	B	(16,494,419)	   6,494,419 	  -   
U	 0122	B	     44,123 	 -   	          44,123 
U	 0122	G	   (400,000)	     444,444 	  44,444

Clarification of Question by jpcp1-ga on 10 Feb 2005 12:57 PST
I tried the macro, its not picking up the outer match.  It's not
picking up cases like  B 0122 G - need to see all balances affecting a
custname even if they didn't report it.
Other cases like are: 
B	 0122	U 
D	 0122	B 
F	 0121	G

Request for Question Clarification by maniac-ga on 13 Feb 2005 08:43 PST
Hello Jpcp1,

The comments on Google Answers are offered freely. You only pay for an
answer from a researcher (such as myself) if it is posted as an
answer. If the comment is satisfactory, I suggest you close the
question.

  --Maniac
Answer  
There is no answer at this time.

Comments  
Subject: Re: Excel Macro-match cutomer data
From: reinedd-ga on 10 Feb 2005 10:09 PST
 
Sub m()

Dim custnames() As Variant
Dim GLAcct() As Variant
Dim AcctWith() As Variant
Dim Amount() As Variant
    Columns("J:J").Select
    Selection.ClearContents

p = 1
z = 2
While Cells(z, 1) <> ""
    z = z + 1
Wend

Range(Cells(2, 3), Cells(z - 1, 3)).Select
Selection.Copy
Cells(1, 10).Select
ActiveSheet.Paste

Range(Cells(2, 1), Cells(z - 1, 1)).Select
Selection.Copy
Cells(z - 1, 10).Select
ActiveSheet.Paste

    Columns(10).Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("J2"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

ReDim custnames(2 * (z + 1)) As Variant
ReDim GLAcct((z + 1)) As Variant
ReDim AcctWith(2 * (z + 1)) As Variant


i = 2
a = 1
While Cells(i, 10) <> ""
    If Cells(i, 10) <> Cells(i + 1, 10) Then
        custnames(a) = Cells(i, 10)
        AcctWith(a) = Cells(i, 10)
        a = a + 1
    End If
    i = i + 1
Wend

    Columns("J:J").Select
    Selection.ClearContents

    Columns("A:D").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("A2") _
        , Order2:=xlAscending, Key3:=Range("C2"), Order3:=xlAscending, Header:= _
        xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
j = 2
b = 1
While Cells(j, 1) <> ""
If Cells(j, 2) <> Cells(j - 1, 2) Then
    GLAcct(b) = Cells(j, 2)
    b = b + 1
End If
j = j + 1
Wend



ReDim Amount(a, b, a) As Variant

For aa = 1 To a
For bb = 1 To b
For cc = 1 To a
For n = 2 To j
If Cells(n, 1) = custnames(aa) And Cells(n, 2) = GLAcct(bb) And
Cells(n, 3) = AcctWith(cc) Then
Amount(aa, bb, cc) = Amount(aa, bb, cc) + Cells(n, 4)
End If
Next
Next
Next
Next

    Columns("e:z").Select
    Selection.ClearContents

Cells(1, 5) = "Match Amt"
Cells(1, 6) = "Diff"

For aa = 1 To a
For bb = 1 To b
For cc = 1 To a
For n = 2 To j
If Cells(n, 1) = custnames(aa) And Cells(n, 2) = GLAcct(bb) And
Cells(n, 3) = AcctWith(cc) Then
Cells(n, 5) = Amount(cc, bb, aa)
Cells(n, 6) = Amount(cc, bb, aa) + Cells(n, 4)
End If
Next
Next
Next
Next

End Sub
Subject: Re: Excel Macro-match cutomer data
From: manuka-ga on 11 Feb 2005 02:57 PST
 
Hi there,

I believe this should fill your requirements exactly.
Not sure how the long lines will go, you may need to reformat.

I implemented this as a button on the sheet, so the macro assumes
that the active sheet has the data. It also assumes that the first
four rows are as in your example, and while it allows for the 
possibility of more than four columns, it assumes that after the
first blank column there is nothing important.

Cheers, manuka-ga



Private Sub Match()
    Dim CurRange As Range, CurCell As Range, Count As Integer, ColCount As Integer
    Dim UniqueCount As Integer, DestRange As Range, FinalRange As Range
    Dim Acct1Ref As String, GLRef As String, Acct2Ref As String,
AmountRef As String
    
    ActiveSheet.UsedRange.RemoveSubtotal
    ActiveSheet.UsedRange.ClearOutline
    Set CurRange = ActiveSheet.Range("A1").CurrentRegion
    ColCount = CurRange.Columns.Count
    Count = CurRange.Rows.Count - 1
    Set DestRange = ActiveSheet.Range("A1").Offset(0, ColCount + 1)
    Set CurRange = ActiveSheet.Range("A1:C" & Count + 1)
    ActiveSheet.Range(DestRange, DestRange.Offset(0, 9)).EntireColumn.Clear
    CurRange.AdvancedFilter xlFilterCopy, , DestRange, True
    Set DestRange = ActiveSheet.Range(DestRange, DestRange.End(xlDown))
    UniqueCount = DestRange.Rows.Count - 1
    DestRange.Copy (DestRange.Offset(UniqueCount + 1, 2).Cells(1, 1))
    DestRange.Offset(0, 1).Copy (DestRange.Offset(UniqueCount + 1, 1).Cells(1, 1))
    DestRange.Offset(0, 2).Copy (DestRange.Offset(UniqueCount + 1, 0).Cells(1, 1))
    Set CurCell = DestRange.Cells(1, 1).Offset(UniqueCount + 1, 0)
    ActiveSheet.Range(CurCell, CurCell.Offset(0, 2)).Delete (xlShiftUp)
    
    Set FinalRange = DestRange.Cells(1, 1).Offset(0, 4)
    Set DestRange = DestRange.Cells(1, 1).CurrentRegion
    DestRange.AdvancedFilter xlFilterCopy, , FinalRange, True
    Set FinalRange = ActiveSheet.Range(FinalRange,
FinalRange.End(xlDown).Offset(0, 2))
    FinalRange.Sort FinalRange.Cells(1, 1), , FinalRange.Cells(1, 2),
, , FinalRange.Cells(1, 3), , xlYes
    
    Set FinalRange = ActiveSheet.Range(FinalRange.Cells(2, 1),
FinalRange.Cells(FinalRange.Rows.Count, 1))
    FinalRange.Cells(1, 1).Offset(-1, 3).Value = "Amount"
    FinalRange.Cells(1, 1).Offset(-1, 4).Value = "Match Amt"
    FinalRange.Cells(1, 1).Offset(-1, 5).Value = "Diff"
    FinalRange.Cells(1, 1).Offset(0, 3).FormulaArray =
"=SUM(IF(R1C1:R" & Count + 1 & "C1=RC[-3],IF(R1C2:R" & Count + 1 & _
        "C2=RC[-2],IF(R1C3:R" & Count + 1 & "C3=RC[-1],R1C4:R" & Count
+ 1 & "C4,0),0),0))"
    FinalRange.Cells(1, 1).Offset(0, 4).FormulaArray =
"=SUM(IF(R1C3:R" & Count + 1 & "C3=RC[-4],IF(R1C2:R" & Count + 1 & _
        "C2=RC[-3],IF(R1C1:R" & Count + 1 & "C1=RC[-2],R1C4:R" & Count
+ 1 & "C4,0),0),0))"
    FinalRange.Offset(0, 3).FillDown
    FinalRange.Offset(0, 4).FillDown
    FinalRange.Offset(0, 5).FormulaR1C1 = "=RC[-1]+RC[-2]"
    FinalRange.Offset(0, 3).NumberFormat = "#,##0;(#,##0)"
    FinalRange.Offset(0, 4).NumberFormat = "#,##0;(#,##0)"
    FinalRange.Offset(0, 5).NumberFormat = "#,##0;(#,##0)"
    
    FinalRange.Cells(1, 1).Subtotal GroupBy:=1, Function:=xlSum,
TotalList:=Array(4, 5, 6), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    FinalRange.Cells(1, 1).Subtotal GroupBy:=2, Function:=xlSum,
TotalList:=Array(4, 5, 6), _
        Replace:=False, PageBreaks:=False, SummaryBelowData:=True

    ActiveSheet.Range(DestRange.Cells(1, 1), DestRange.Cells(1,
1).Offset(0, 3)).EntireColumn.Delete
    
    Application.Calculate
    
End Sub
Subject: Re: Excel Macro-match cutomer data
From: jpcp1-ga on 11 Feb 2005 06:02 PST
 
manuka-ga
looks good on test sheet - need to do some more testing on full 1500
lines will let you know.
Subject: Re: Excel Macro-match cutomer data
From: jpcp1-ga on 11 Feb 2005 12:33 PST
 
manuka-ga - works well thanks - now how do you post as answer so we
can complete transactopm
Regards
jpcp1-ga

Important Disclaimer: Answers and comments provided on Google Answers are general information, and are not intended to substitute for informed professional medical, psychiatric, psychological, tax, legal, investment, accounting, or other professional advice. Google does not endorse, and expressly disclaims liability for any product, manufacturer, distributor, service or service provider mentioned or any opinion expressed in answers or comments. Please read carefully the Google Answers Terms of Service.

If you feel that you have found inappropriate content, please let us know by emailing us at answers-support@google.com with the question ID listed above. Thank you.
Search Google Answers for
Google Answers  


Google Home - Answers FAQ - Terms of Service - Privacy Policy