|  | 
 | 
|  | ||
| 
 | 
| 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 | |
| 
 | |
| 
 | 
|  | ||
| 
 | 
| There is no answer at this time. | 
|  | ||
| 
 | 
| 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 | 
| 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 Home - Answers FAQ - Terms of Service - Privacy Policy |