DataBlake
Well-known Member
- Joined
- Jan 26, 2015
- Messages
- 781
- Office Version
- 2016
- Platform
- Windows
Code:
Sub aaa()
Dim childROWmax As Long
Dim parentROWmax As Long
Dim i As Long
Dim j As Long
Dim z As Long
Dim n As Long
Dim desc As Long
Dim parentPATTERN As Range
Dim parentPATTERN2 As Range
Dim parentWEIGHT As Range
Dim childPATTERN As Range
Dim oMAX As Range
Dim oMIN As Range
Dim childCODE As Range
Dim parentPART As Range
Dim newPART As String
Dim newSHEET As Worksheet
Dim oldSHEET As Worksheet
Set oldSHEET = ActiveSheet
parentROWmax = oldSHEET.Cells(Rows.Count, 1).End(xlUp).Row
Set newSHEET = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
newSHEET.Name = "Result"
childROWmax = Sheets("TitleHelper").Cells(Rows.Count, 1).End(xlUp).Row
MHTROWmax = newSHEET.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To parentROWmax
z = 1
p = 4
'Increment Result sheet row
MHTROWmax = MHTROWmax + 1
'get MHT row info for comparison
Set parentPATTERN = oldSHEET.Range("J" & i)
Set parentPATTERN2 = oldSHEET.Range("K" & i)
Set parentWEIGHT = oldSHEET.Range("H" & i)
Set parentPART = oldSHEET.Range("A" & i)
'Write a row to MHT Result Table
oldSHEET.Rows(i).Copy newSHEET.Rows(MHTROWmax)
For j = 2 To childROWmax
'get TitleHelper row info for comparison
Set childPATTERN = Worksheets("TitleHelper").Range("A" & j)
Set oMAX = Worksheets("TitleHelper").Range("C" & j)
Set oMIN = Worksheets("TitleHelper").Range("B" & j)
Set childCODE = Worksheets("TitleHelper").Range("F" & j)
newPART = parentPART & "*" & childCODE
'Perform if/then
If (parentPATTERN = childPATTERN _
Or parentPATTERN2 = childPATTERN) _
And parentWEIGHT <= oMAX _
And parentWEIGHT >= oMIN _
And z < 5 Then
z = z + 1
'Increment Result sheet row
MHTROWmax = MHTROWmax + 1
'Criteria is met, write a row to MHT Result Table
oldSHEET.Rows(i).Copy newSHEET.Rows(MHTROWmax)
newSHEET.Cells(MHTROWmax, 1) = newPART
For desc = 2 To childROWmax
If (oldSHEET.Range("J" & desc) = Worksheets("TitleHelper").Range("A" & desc) _
Or oldSHEET.Range("K" & desc) = Worksheets("TitleHelper").Range("A" & desc)) _
And oldSHEET.Range("H" & desc) <= Worksheets("TitleHelper").Range("C" & desc) _
And oldSHEET.Range("H" & desc) >= Worksheets("TitleHelper").Range("B" & desc) _
And n < 5 Then
n = n + 1
newSHEET.Cells(MHTROWmax, 20 + n) = Worksheets("TitleHelper").Range("E" & desc).Value
[B][SIZE=4][COLOR=#ff0000]Next desc[/COLOR][/SIZE][/B]
End If
Next j
Next i
End Sub
can't figure out why its throwing me this error on "next desc"
"compile error: next without for"