Accounting Problem. Complex Copy/Paste and Index/Match too.

[ryguy7272]

I have to look at debits and credits spit out by in the form of a database
query. For whatever reason, the query results are basically split into
quadrants like 1 & 2 on the top and 3 & 4 directly underneath. Data appears
only in quadrant 2 (upper right) and 3 (lower left), on a sheet named
‘Sheet1’. For the most part all debits are perfectly offset with matching
credits and all credits are perfectly offset with matching debits . . .
unless the persons entering the data mistype (and people do make mistakes).
There could be a couple hundred entries for instance, let’s say I have the
following in Columns B:G -> A, B, C, AA, BB, CC (commas denote different
columns). Also, let’s say I have the following in rows 2:7 -> A, B, C, AA,
BB, CC (commas denote different rows).

So, I think the easiest and best way to handle this task is to take all data
from Quadrant 2 and copy/paste to a new sheet (I would put the data below but
I don’t know how many rows will be used on the first sheet and there is
already a lot of data on this first sheet).

So, in A1:G7, I have this scenario:
A B C AA BB CC
A 5 1 9
B 4 6 2
C 3 7 8
AA -5 -4 -3
BB -1 -6 -7
CC -9 -2 -8

In the new sheet, I’d like to see this in A1:E9:
A 1 BB -1
A 5 AA -5
A 9 CC -9
B 2 CC -2
B 4 AA -4
B 6 CC -6
C 3 AA -3
C 7 BB -7
C 8 CC -8

Does it make sense? In row 2, I have 5, 1, 9, so I’d like to see these
numbers in Column B (new sheet; named ‘SummarySheet’) with the corresponding
As in Column A. Then the Bs, and then the Cs. As if that’s not enough, I’d
really like to see the opposite numbers in Column D (the offsetting credits
for the debits and the debits for the credits) and the letters that those
numbers match to in Column C (I guess it would be some sort of index/match).

I was working on some code to copy the data to the new sheet. It may be
something like this (below). This, however, doesn’t do what I described
above:
Sub Accounting()

Set wb = ThisWorkbook

'Delete the sheet "TransposedSheet" if it exist
Application.DisplayAlerts = False: On Error Resume Next
wb.Sheets("SummarySheet").Delete
On Error GoTo 0: Application.DisplayAlerts = True

Set wsSummary = wb.Worksheets.Add
wsSummary.Name = "SummarySheet"
Set wsSheet1 = wb.Sheets("Sheet1")

'Assume start position is 1,1
lngLastRow = wsSheet1.Cells(Rows.Count, "A").End(xlUp).Row - 1
lngLastCol = wsSheet1.Cells(3, Columns.Count).End(xlToLeft).Column
lngNewRow = 1
For lngRow = 1 To lngLastRow
For lngCol = 1 To lngLastCol

lngNewRow = lngNewRow + 1

wsSummary.Range("A" & lngNewRow).Value = wsSheet1.Cells(lngRow, 1)
wsSummary.Range("B" & lngNewRow).Value = wsSheet1.Cells(1, lngCol)
wsSummary.Range("C" & lngNewRow).Value = wsSheet1.Cells(lngRow, lngCol)

Next
Next

End Sub

It’s kind of complex. Please let me know if you have any questions.

Thanks!!
Ryan---

 

[Don Guillett]

If desired, send your file to my address below. I will only look if:
1. You send a copy of this message on an inserted sheet
2. You give me the newsgroup and the subject line
3. You send a clear explanation of what you want
4. You send before/after examples and expected results.