PDA

View Full Version : Solved: Lookup &amp; transpose variable range from 1 To 3 columns

thole
03-31-2008, 12:10 PM
Hello, all.
I need to do the following:
I have data in 1 row in a format that looks like this:
A B C D E
106 widget1 \$120 20 list of uniques from column B
106 widget2 \$200 25
106 widget3 \$300 10
107 widget1 \$100 18
108 widget3 \$200 7

what I need is a summary of where each widget is (Column A), and how many (Column D), in columns:

Widget1
data from column A data from column D data from column A data from column D
data from column A data from column D data from column A data from column D
data from column A data from column D data from column A data from column D
Sum by Widget of Column C

Widget2
data from column A data from column D data from column A data from column D
data from column A data from column D data from column A data from column D
data from column A data from column D data from column A data from column D
Sum by Widget of Column C

and so on.

There will be a maximum of 30 rows with the same data in column A.

ANY help will be greatly apreciated!

Bob Phillips
03-31-2008, 01:17 PM
Your output is not clear. Why 3 rows for widget 1, why 2 per row?

thole
03-31-2008, 01:21 PM
I will have an inventory of any number of rooms, any of which will have up to 30 different "widgets" (so up to 30 rows, all starting with the 3-digit room number), with different prices.
What I need to do is get a widget summary with total widget sum (easy to do), and either a summary or a concatenation of rooms and quantities of those widgets.
Does this help any?

thole
03-31-2008, 01:23 PM
Me estoy rompiendo el craneo, peor no sale mucho....:banghead:

thole
03-31-2008, 01:25 PM
The output (because of stylistic reasons imposed by higher-ups) needs to be in three columns...
Is this any clearer?

Bob Phillips
03-31-2008, 01:40 PM
How close is this to what you need?

Public Sub ProcessData()
Const TEST_COLUMN As String = "B" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim NextRow As Long
Dim RowNum As Long
Dim sh As Worksheet

Set sh = Worksheets("Sheet2")
With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = LastRow To 1 Step -1

NextRow = 0
On Error Resume Next
NextRow = Application.Match(.Cells(i, TEST_COLUMN).Value, sh.Columns(1), 0)
On Error GoTo 0
If NextRow = 0 Then

sh.Rows(1).Insert
sh.Range("A1").Value = .Cells(i, TEST_COLUMN).Value & " Total"
sh.Rows(1).Insert
sh.Range("A1").Value = .Cells(i, TEST_COLUMN).Value
NextRow = 2
Else

NextRow = NextRow + 1
End If

sh.Rows(NextRow).Insert
sh.Cells(NextRow, "A").Value = .Cells(i, "B").Value
sh.Cells(NextRow, "B").Value = .Cells(i, "D").Value
On Error Resume Next
RowNum = Application.Match(.Cells(i, TEST_COLUMN).Value & " Total", sh.Columns(1), 0)
On Error GoTo 0
sh.Cells(RowNum, "B").Value = sh.Cells(RowNum, "B").Value + .Cells(i, "C").Value
Next i

End With

End Sub

thole
03-31-2008, 02:09 PM
OUTSTANDING!!!!!
Muchisimas gracias, senor!!!
:thumb

Bob Phillips
03-31-2008, 02:39 PM
Just a thought, wouldn't a pivot table have achieved what you want?

thole
03-31-2008, 04:25 PM
Possibly; I do not know enough about them - I am just crawling.... not walking yet.

thole
04-01-2008, 11:59 AM
Thank you very much once again for your code, yesterday!
I tried to get each in their own sheet, instead of all on sheet 2, and used the following code, which is not really working....
If you would be kind enough to help me out once more?
Thank you.

Application.ScreenUpdating = False

For Each c In Worksheets("Hidden_Calculations").Range("i11:i20000").Cells
If c <> "" Then

Const TEST_COLUMN As String = "a" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim NextRow As Long
Dim RowNum As Long
Dim sh As Worksheet

Set sh = Worksheets(Worksheets.Count)
With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = LastRow To 1 Step -1

NextRow = 0
On Error Resume Next
NextRow = Application.Match(.Cells(i, TEST_COLUMN).Value, sh.Columns(1), 0)
On Error GoTo 0
If NextRow = 0 Then

sh.Rows(1).Insert
sh.Range("A10").Value = .Cells(i, TEST_COLUMN).Value & " Total"
sh.Rows(1).Insert
sh.Range("A10").Value = .Cells(i, TEST_COLUMN).Value
NextRow = 2
Else

NextRow = NextRow + 1
End If

sh.Rows(NextRow).Insert
sh.Cells(NextRow, "A").Value = .Cells(i, "B").Value
sh.Cells(NextRow, "B").Value = .Cells(i, "D").Value
On Error Resume Next
RowNum = Application.Match(.Cells(i, TEST_COLUMN).Value & " Total", sh.Columns(1), 0)
On Error GoTo 0
sh.Cells(RowNum, "B").Value = sh.Cells(RowNum, "B").Value + .Cells(i, "C").Value
Next i

End With

End If

Next

End Sub

Bob Phillips
04-01-2008, 12:40 PM
Public Sub ProcessData()
Const TEST_COLUMN As String = "B" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim NextRow As Long
Dim RowNum As Long
Dim sh As Worksheet

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = LastRow To 1 Step -1

Set sh = Nothing
On Error Resume Next
Set sh = .Parent.Worksheets(.Cells(i, TEST_COLUMN).Value)
On Error GoTo 0
If sh Is Nothing Then

Set sh = .Parent.Worksheets.Add(after:=.Parent.Worksheets(.Parent.Worksheets.Count))
sh.Name = .Cells(i, TEST_COLUMN).Value
End If

NextRow = 0
On Error Resume Next
NextRow = Application.Match(.Cells(i, TEST_COLUMN).Value, sh.Columns(1), 0)
On Error GoTo 0
If NextRow = 0 Then

sh.Rows(1).Insert
sh.Range("A1").Value = .Cells(i, TEST_COLUMN).Value & " Total"
sh.Rows(1).Insert
sh.Range("A1").Value = .Cells(i, TEST_COLUMN).Value
NextRow = 2
Else

NextRow = NextRow + 1
End If

sh.Rows(NextRow).Insert
sh.Cells(NextRow, "A").Value = .Cells(i, "B").Value
sh.Cells(NextRow, "B").Value = .Cells(i, "D").Value
On Error Resume Next
RowNum = Application.Match(.Cells(i, TEST_COLUMN).Value & " Total", sh.Columns(1), 0)
On Error GoTo 0
sh.Cells(RowNum, "B").Value = sh.Cells(RowNum, "B").Value + .Cells(i, "C").Value
Next i
End With

End Sub

thole
04-01-2008, 01:30 PM
Thank you sir; if you're in Santiago, I'll owe you lunch next time I go visit my sister!

mdmackillop
04-01-2008, 01:48 PM
Hi Thole
If your question is solved, you can mark it so using the Thread Tools dropdown.