Making Sub MakeMaster work

M

Max

Re-posting this afresh for help here (from a thread in .worksheet.functions)
since it received no replies over there for several days past.

I hit some problems trying out Joel's Sub MakeMaster() below

Prepared this sample set-up
with 3 sheets: Cat1, Cat2, Master

In sheet: Cat1

Qty Part# ProdDesc
b ... 10 Dat11
2 ... 10 Dat12
5 ... 15 Dat13

In sheet: Cat2

Qty Part# ProdDesc
1 ... 14 Dat21
b ... 15 Dat22
3 ... 17 Dat23

where b = blank (no qty was input)

Then in sheet: Master,
started with only the headers in A1:C1

Qty Part# ProdDesc

When the sub is run, the expected
results would be something like this:

Qty Part# ProdDesc
2 10 Dat12
5 15 Dat13
1 14 Dat21
3 17 Dat23

But when I ran Joel's sub, I got this in Master,
it hung so I CTRL+Breaked it

Qty Field1 Desc
1 14 Dat21
1 14 Dat21
1 14 Dat21
(Repeat interminably ...)

How can it be made to produce the expected results?

Thanks
Max

---------------
Sub MakeMaster()
'Joel
Set MasterSht = Sheets("Master")

NewRow = 2
For Each sht In Worksheets
If UCase(sht.Name) <> "MASTER" Then
RowCount = 2
Do While sht.Range("A" & RowCount) <> ""
If sht.Range("A" & RowCount) > 0 Then
sht.Rows(RowCount).Copy _
Destination:=MasterSht.Rows(NewRow)
NewRow = NewRow + 1
End If
Loop
End If
Next sht
End Sub
 
B

Bob Phillips

Sub MakeMaster()
Dim MasterSht As Worksheet
Dim sht As Worksheet
Dim Newrow As Long
Dim RowCount As Long

Set MasterSht = Worksheets("Master")

Newrow = 2
For Each sht In Worksheets

If UCase(sht.Name) <> "MASTER" Then

RowCount = 2
Do While sht.Range("B" & RowCount).Value <> ""

If sht.Range("A" & RowCount).Value > 0 Then

sht.Rows(RowCount).Copy _
Destination:=MasterSht.Rows(Newrow)
Newrow = Newrow + 1
End If
RowCount = RowCount + 1
Loop
End If
Next sht
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top