Complicated macro needed (please)

[Kjell]

I been searching all the excel forums hoping to find the proper macro
code to perform a function. I'm writing to the forum as I've hit a
brick wall.

I have a data sheet used for listing parts and storage locations.
Individual Parts names are listed in column E.
The cells in column E are links (not text).
The storage locations (20 of them) are listed in columns W to AR.
Not every Part uses all 20 storage locations.
There is 500 rows listing the parts and their storage locations.
Columns F to V also hold information that is not relevant to the
macro.

For example - sheet (Data)

E (F to V) W X Y Z (etc to AR)

Row 7 Item1 Isle1 Isle2 Isle6
Row 8 Item2 Isle8 Isle4 Isle5

(links) (Columns W to AR are text)

I need a macro that starts in W7 in sheet (Data) and if it sees a
value then copy that value into cell B7 in a sheet named "List". I
then need it to copy the value (must be: Edit, Paste Special, Value)
from (Data) E7 into "List" C7. The macro then looks in (Data) X7 and
if it sees a value, copy that into the next row down into "List" (B8)
and again copy (Data) E7 into "List" C8. If the macro does not see a
value in (Data) Y7 it skips to Z7 checking every cell until AS7,
copying information if found to the next line in "List", skipping to
next cell if not found. After checking AR7 it moves down to the next
row and looks in W8 for the first location of Item2 and repeats the
above process - (copy W8 and E8 to next line in "List" if W8 is
populated, skip to X8 if W8 is empty), following this pattern all the
way down to (Data) AR507.

The result I have been trying to end up with in "List" would look like
this:

Sheet "List"

B C

Isle1 Item1
Isle2 Item1
Isle6 Item1
Isle8 Item2
Isle4 Item2
Isle5 Item2

I have come to the conclusion that there is no way I can do this on my
own.

Thanks in advance for any help that is offered.

 

[Dave Peterson]

W to AR is 22 columns--I'm guessing that this doesn't matter.

You could copy|paste special transpose all 22 cells (one row at a time), then
wipe out the empty cells/rows.

Here's one way:

Option Explicit
Sub testme01()

Dim curWks As Worksheet
Dim newWks As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim iRow As Long
Dim oRow As Long
Dim NumberOfRows As Long

Set curWks = Worksheets("Data")

'delete old List worksheet
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("list").Delete
Application.DisplayAlerts = True
On Error GoTo 0

Set newWks = Worksheets.Add
newWks.Name = "List"

oRow = 1
With curWks
FirstRow = 7
LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
FirstCol = .Range("w1").Column
LastCol = .Range("ar1").Column
NumberOfRows = LastCol - FirstCol + 1

For iRow = FirstRow To LastRow
newWks.Cells(oRow, "C").Resize(NumberOfRows).Value _
= .Cells(iRow, "E").Value
newWks.Cells(oRow, "B").Resize(NumberOfRows).Value _
= Application.Transpose( _
.Cells(iRow, FirstCol).Resize(1, NumberOfRows).Value)
oRow = oRow + NumberOfRows
Next iRow

End With


On Error Resume Next
newWks.Range("b:b").Cells.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

End Sub


If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

 

[Kjell]

Dave, the macro you wrote is perfect! Thank you so much. I did a copy
/ paste into the workbook and it ran without a hitch producing the
output I was hoping to achieve. Thanks again for helping.

 

[Dave Peterson]

Woohoo!

Glad it worked ok.

Dave, the macro you wrote is perfect! Thank you so much. I did a copy
/ paste into the workbook and it ran without a hitch producing the
output I was hoping to achieve. Thanks again for helping.