Joel,
Nice to hear from you again. I was looking modify the code a little, but I
couldn't figure out. Anyway, the only change I need is before instead of
skipping the whole row (column I to N) if column I is specified as ASC, I
need it to only skip the cells where ASC or COMP is specified within column I
thru N.
Anyway, here is the current code I am using that you helped me.
Const OP = 0
Const SO = 1
Const DD = 2 'delivery date
Const Ref1300 = 0
Const Ref1500 = 1
Const Ref1700 = 2
Private Sub Luong()
' Luong Macro
' Macro recorded 9/20/2007 by Luong Hua
'
Dim R1300M100(10000, 3)
Dim R1300M200(10000, 3)
Dim R1300M300(10000, 3)
Dim R1500M100(10000, 3)
Dim R1500M200(10000, 3)
Dim R1500M300(10000, 3)
Dim R1700M100(10000, 3)
Dim R1700M200(10000, 3)
Dim R1700M300(10000, 3)
With Sheets(“100â€)
LastRowSh1 = _
.Cells(Rows.Count, "I").End(xlUp).Row
If LastRowSh1 <> 1 Then
Set ColIRange = .Range(.Cells(2, "I"), _
.Cells(LastRowSh1, "I"))
For Each Cell In ColIRange
If (Cell <> "Asc") And _
(.Rows(Cell.Row).Hidden = False) Then
.Range("H" & Cell.Row & ":X" & Cell.Row).ClearContents
End If
Next Cell
End If
End With
With Sheets(“200â€)
LastRowSh2 = _
.Cells(Rows.Count, "I").End(xlUp).Row
If LastRowSh2 <> 1 Then
Set ColIRange = .Range(.Cells(2, "I"), _
.Cells(LastRowSh2, "I"))
For Each Cell In ColIRange
If (Cell <> "Asc") And _
(.Rows(Cell.Row).Hidden = False) Then
.Range("H" & Cell.Row & ":X" & Cell.Row).ClearContents
End If
Next Cell
End If
End With
With Sheets(“300â€)
LastRowSh3 = _
.Cells(Rows.Count, "I").End(xlUp).Row
If LastRowSh3 <> 1 Then
Set ColIRange = .Range(.Cells(2, "I"), _
.Cells(LastRowSh3, "I"))
For Each Cell In ColIRange
If (Cell <> "Asc") And _
(.Rows(Cell.Row).Hidden = False) Then
.Range("H" & Cell.Row & ":X" & Cell.Row).ClearContents
End If
Next Cell
End If
End With
LastRowSh4 = Sheets("Data"). _
Cells(Rows.Count, "A").End(xlUp).Row
R1300M100Count = 0
R1300M200Count = 0
R1300M300Count = 0
R1500M100Count = 0
R1500M200Count = 0
R1500M300Count = 0
R1700M100Count = 0
R1700M200Count = 0
R1700M300Count = 0
With Sheets("Data")
For Sh4RowCount = 3 To LastRowSh4
If IsError(.Cells(Sh4RowCount, "L").Value) Then
OPeration = -1
Else
OPeration = .Cells(Sh4RowCount, "L").Value
End If
If IsError(.Cells(Sh4RowCount, "A").Value) Then
Order = -1
Else
Order = .Cells(Sh4RowCount, "A").Value
End If
If IsError(.Cells(Sh4RowCount, "P").Value) Then
Model = -1
Else
Model = .Cells(Sh4RowCount, "P").Value
End If
If IsError(.Cells(Sh4RowCount, "H").Value) Then
DDate = DateValue("1/1/1900")
Else
DDate = .Cells(Sh4RowCount, "H").Value
End If
If IsError(.Cells(Sh4RowCount, "O").Value) Then
Item = ""
Else
Item = Trim(.Cells(Sh4RowCount, "O"))
End If
If Left(Item, 2) = "13" Then
If Model = 700 Then
R1300M100Count = R1300M100Count + 1
R1300M100(R1300M100Count, OP) = _
OPeration
R1300M100(R1300M100Count, SO) = _
Order
R1300M100(R1300M100Count, DD) = _
DDate
End If
If Model = 800 Then
R1300M200Count = R1300M200Count + 1
R1300M200(R1300M200Count, OP) = _
OPeration
R1300M200(R1300M200Count, SO) = _
Order
R1300M200(R1300M200Count, DD) = _
DDate
End If
If Model = 900 Then
R1300M300Count = R1300M300Count + 1
R1300M300(R1300M300Count, OP) = _
OPeration
R1300M300(R1300M300Count, SO) = _
Order
R1300M300(R1300M300Count, DD) = _
DDate
End If
End If
If Left(Item, 2) = "15" Then
If Model = 700 Then
R1500M100Count = R1500M100Count + 1
R1500M100(R1500M100Count, OP) = _
OPeration
R1500M100(R1500M100Count, SO) = _
Order
R1500M100(R1500M100Count, DD) = _
DDate
End If
If Model = 800 Then
R1500M200Count = R1500M200Count + 1
R1500M200(R1500M200Count, OP) = _
OPeration
R1500M200(R1500M200Count, SO) = _
Order
R1500M200(R1500M200Count, DD) = _
DDate
End If
If Model = 900 Then
R1500M300Count = R1500M300Count + 1
R1500M300(R1500M300Count, OP) = _
OPeration
R1500M300(R1500M300Count, SO) = _
Order
R1500M300(R1500M300Count, DD) = _
DDate
End If
End If
If Left(Item, 2) = "17" Then
If Model = 700 Then
R1700M100Count = R1700M100Count + 1
R1700M100(R1700M100Count, OP) = _
OPeration
R1700M100(R1700M100Count, SO) = _
Order
R1700M100(R1700M100Count, DD) = _
DDate
End If
If Model = 800 Then
R1700M200Count = R1700M200Count + 1
R1700M200(R1700M200Count, OP) = _
OPeration
R1700M200(R1700M200Count, SO) = _
Order
R1700M200(R1700M200Count, DD) = _
DDate
End If
If Model = 900 Then
R1700M300Count = R1700M300Count + 1
R1700M300(R1700M300Count, OP) = _
OPeration
R1700M300(R1700M300Count, SO) = _
Order
R1700M300(R1700M300Count, DD) = _
DDate
End If
End If
Next Sh4RowCount
End With
Call SortData(R1300M100, R1300M100Count)
Call SortData(R1300M200, R1300M200Count)
Call SortData(R1300M300, R1300M300Count)
Call SortData(R1500M100, R1500M100Count)
Call SortData(R1500M200, R1500M200Count)
Call SortData(R1500M300, R1500M300Count)
Call SortData(R1700M100, R1700M100Count)
Call SortData(R1700M200, R1700M200Count)
Call SortData(R1700M300, R1700M300Count)
Call InsertData(R1300M100, R1300M100Count, _
Ref1300, 700, “100â€)
Call InsertData(R1300M200, R1300M200Count, _
Ref1300, 800, “200â€)
Call InsertData(R1300M300, R1300M300Count, _
Ref1300, 900, “300â€)
Call InsertData(R1500M100, R1500M100Count, _
Ref1500, 700, “100â€)
Call InsertData(R1500M200, R1500M200Count, _
Ref1500, 800, “200â€)
Call InsertData(R1500M300, R1500M300Count, _
Ref1500, 900, “300â€)
Call InsertData(R1700M100, R1700M100Count, _
Ref1700, 700, “100â€)
Call InsertData(R1700M200, R1700M200Count, _
Ref1700, 800, “200â€)
Call InsertData(R1700M300, R1700M300Count, _
Ref1700, 900, “300â€)
End Sub
Sub SortData(ByRef MyArray() As Variant, Count)
'Sort by Delivery Date
For i = 0 To (Count - 1)
For j = (i + 1) To Count
If MyArray(j, DD) < MyArray(i, DD) Then
Temp = MyArray(i, OP)
MyArray(i, OP) = MyArray(j, OP)
MyArray(j, OP) = Temp
Temp = MyArray(i, SO)
MyArray(i, SO) = MyArray(j, SO)
MyArray(j, SO) = Temp
Temp = MyArray(i, DD)
MyArray(i, DD) = MyArray(j, DD)
MyArray(j, DD) = Temp
End If
Next j
Next i
'Sort by Operation
For i = 0 To (Count - 1)
For j = (i + 1) To Count
If MyArray(j, OP) > MyArray(i, OP) Then
Temp = MyArray(i, OP)
MyArray(i, OP) = MyArray(j, OP)
MyArray(j, OP) = Temp
Temp = MyArray(i, SO)
MyArray(i, SO) = MyArray(j, SO)
MyArray(j, SO) = Temp
Temp = MyArray(i, DD)
MyArray(i, DD) = MyArray(j, DD)
MyArray(j, DD) = Temp
End If
Next j
Next i
End Sub
Sub InsertData(ByRef MyArray() As Variant, _
Count, Ref, Model, InsertSheet)
With Sheets(InsertSheet)
RowCount = 2
MyOffset = 0
Do While (Not IsEmpty(.Cells(RowCount, "I")) And _
(.Cells(RowCount, "H") <> Model)) Or _
(.Cells(RowCount, "I") = "Asc") Or _
(.Rows(RowCount).Hidden = True)
RowCount = RowCount + 1
Loop
For LoopCount = 0 To (Count - 1)
.Cells(RowCount, "I"). _
Offset(0, (2 * Ref) + MyOffset) = _
MyArray(LoopCount, SO)
.Cells(RowCount, "Q"). _
Offset(0, (2 * Ref) + MyOffset) = _
MyArray(LoopCount, OP)
If MyOffset = 0 Then
.Cells(RowCount, "H").Value = Model
MyOffset = 1
Else
RowCount = RowCount + 1
Do While (Not IsEmpty(.Cells(RowCount, "I")) And _
(.Cells(RowCount, "H") <> Model)) Or _
(.Cells(RowCount, "I") = "Asc") Or _
(.Rows(RowCount).Hidden = True)
RowCount = RowCount + 1
Loop
MyOffset = 0
End If
Next LoopCount
End With
End Sub