![]() |
|
|
| 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 |