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, lets say I have the
following in Columns B:G - A, B, C, AA, BB, CC (commas denote different
columns). Also, lets 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 dont 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, Id 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 Id 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 thats not enough, Id
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, doesnt 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

Its kind of complex. Please let me know if you have any questions.

Thanks!!
Ryan---


--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.