C
Cam
Hello,
I have the following existing code that find the first eligible row, and to
start filling
in data from an array, looking for the next eligible row (skip the row with
"ASC" written in column I) after filling in 8 columns (I:N) and looping as
many times as is specified in the call from the main routine.
I would like to modify the code so that instead of skip the entire row if
column I is "ASC", but only skip the cell with "ASC" instead, but still in
fill the data without "ASC" on the same row.
Old code sample data:
A H I J K L M N O
P
Line# Mod 1300 1300 1500 1500 1700 1700 1100 1100
001 300 ASC
002 100 x x x x x x x
003 200 x x x x x x x
x
skip row 2 with line# 001 cause "ASC" is in column I2 so skipping cell J2
thru
N2). Where x is data that the macro fill in.
New code wanted:
A H I J K L M N O
P
Line# Mod 1300 1300 1500 1500 1700 1700 1100 1100
001 300 ASC x ASC x x x x
ASC
002 100 x ASC x x x x x
ASC
003 200 x x x x x x x
x
it does not skip row 2 with line# 001, but rather fill in the missing cell
(J2, L2, M2 and N2) without "ASC" in the cell.
Here is my old VBA code:
Const OP = 0
Const SO = 1
Const DD = 2 'delivery date
Const Ref1300 = 0
Const Ref1500 = 1
Const Ref1700 = 2
Const Ref1100 = 3
Private Sub Macro()
' Macro Macro
'
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)
Dim R1100M100(10000, 3)
Dim R1100M200(10000, 3)
Dim R1100M300(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
R1100M100Count = 0
R1100M200Count = 0
R1100M300Count = 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/1300")
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 = 100 Then
R1300M100Count = R1300M100Count + 1
R1300M100(R1300M100Count, OP) = _
OPeration
R1300M100(R1300M100Count, SO) = _
Order
R1300M100(R1300M100Count, DD) = _
DDate
End If
If Model = 200 Then
R1300M200Count = R1300M200Count + 1
R1300M200(R1300M200Count, OP) = _
OPeration
R1300M200(R1300M200Count, SO) = _
Order
R1300M200(R1300M200Count, DD) = _
DDate
End If
If Model = 300 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 = 100 Then
R1500M100Count = R1500M100Count + 1
R1500M100(R1500M100Count, OP) = _
OPeration
R1500M100(R1500M100Count, SO) = _
Order
R1500M100(R1500M100Count, DD) = _
DDate
End If
If Model = 200 Then
R1500M200Count = R1500M200Count + 1
R1500M200(R1500M200Count, OP) = _
OPeration
R1500M200(R1500M200Count, SO) = _
Order
R1500M200(R1500M200Count, DD) = _
DDate
End If
If Model = 300 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 = 100 Then
R1700M100Count = R1700M100Count + 1
R1700M100(R1100M100Count, OP) = _
OPeration
R1700M100(R1700M100Count, SO) = _
Order
R1700M100(R1700M100Count, DD) = _
DDate
End If
If Model = 200 Then
R1700M200Count = R1700M200Count + 1
R1700M200(R1700M200Count, OP) = _
OPeration
R1700M200(R1700M200Count, SO) = _
Order
R1700M200(R1700M200Count, DD) = _
DDate
End If
If Model = 300 Then
R1700M300Count = R1700M300Count + 1
R1700M300(R1700M300Count, OP) = _
OPeration
R1700M300(R1700M300Count, SO) = _
Order
R1700M300(R1700M300Count, DD) = _
DDate
End If
End If
If Left(Item, 2) = "11" Then
If Model = 100 Then
R1100M100Count = R1100M100Count + 1
R1100M100(R1100M100Count, OP) = _
OPeration
R1100M100(R1100M100Count, SO) = _
Order
R1100M100(R1100M100Count, DD) = _
DDate
End If
If Model = 200 Then
R1100M200Count = R1100M200Count + 1
R1100M200(R1100M200Count, OP) = _
OPeration
R1100M200(R1100M200Count, SO) = _
Order
R1100M200(R1100M200Count, DD) = _
DDate
End If
If Model = 300 Then
R1100M300Count = R1100M300Count + 1
R1100M300(R1100M300Count, OP) = _
OPeration
R1100M300(R1100M300Count, SO) = _
Order
R1100M300(R1100M300Count, 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 SortData(R1100M100, R1100M100Count)
Call SortData(R1100M200, R1100M200Count)
Call SortData(R1100M300, R1100M300Count)
Call InsertData(R1300M100, R1300M100Count, _
Ref1300, 100, "100")
Call InsertData(R1300M200, R1300M200Count, _
Ref1300, 200, "200")
Call InsertData(R1300M300, R1300M300Count, _
Ref1300, 300, "300")
Call InsertData(R1500M100, R1500M100Count, _
Ref1500, 100, "100")
Call InsertData(R1500M200, R1500M200Count, _
Ref1500, 200, "200")
Call InsertData(R1500M300, R1500M300Count, _
Ref1500, 300, "300")
Call InsertData(R1700M100, R1700M100Count, _
Ref1700, 100, "100")
Call InsertData(R1700M200, R1700M200Count, _
Ref1700, 200, "200")
Call InsertData(R1700M300, R1700M300Count, _
Ref1700, 300, "300")
Call InsertData(R1100M100, R1100M100Count, _
Ref1100, 100, "100")
Call InsertData(R1100M200, R1100M200Count, _
Ref1100, 200, "200")
Call InsertData(R1100M300, R1100M300Count, _
Ref1100, 300, "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
I have the following existing code that find the first eligible row, and to
start filling
in data from an array, looking for the next eligible row (skip the row with
"ASC" written in column I) after filling in 8 columns (I:N) and looping as
many times as is specified in the call from the main routine.
I would like to modify the code so that instead of skip the entire row if
column I is "ASC", but only skip the cell with "ASC" instead, but still in
fill the data without "ASC" on the same row.
Old code sample data:
A H I J K L M N O
P
Line# Mod 1300 1300 1500 1500 1700 1700 1100 1100
001 300 ASC
002 100 x x x x x x x
003 200 x x x x x x x
x
skip row 2 with line# 001 cause "ASC" is in column I2 so skipping cell J2
thru
N2). Where x is data that the macro fill in.
New code wanted:
A H I J K L M N O
P
Line# Mod 1300 1300 1500 1500 1700 1700 1100 1100
001 300 ASC x ASC x x x x
ASC
002 100 x ASC x x x x x
ASC
003 200 x x x x x x x
x
it does not skip row 2 with line# 001, but rather fill in the missing cell
(J2, L2, M2 and N2) without "ASC" in the cell.
Here is my old VBA code:
Const OP = 0
Const SO = 1
Const DD = 2 'delivery date
Const Ref1300 = 0
Const Ref1500 = 1
Const Ref1700 = 2
Const Ref1100 = 3
Private Sub Macro()
' Macro Macro
'
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)
Dim R1100M100(10000, 3)
Dim R1100M200(10000, 3)
Dim R1100M300(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
R1100M100Count = 0
R1100M200Count = 0
R1100M300Count = 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/1300")
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 = 100 Then
R1300M100Count = R1300M100Count + 1
R1300M100(R1300M100Count, OP) = _
OPeration
R1300M100(R1300M100Count, SO) = _
Order
R1300M100(R1300M100Count, DD) = _
DDate
End If
If Model = 200 Then
R1300M200Count = R1300M200Count + 1
R1300M200(R1300M200Count, OP) = _
OPeration
R1300M200(R1300M200Count, SO) = _
Order
R1300M200(R1300M200Count, DD) = _
DDate
End If
If Model = 300 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 = 100 Then
R1500M100Count = R1500M100Count + 1
R1500M100(R1500M100Count, OP) = _
OPeration
R1500M100(R1500M100Count, SO) = _
Order
R1500M100(R1500M100Count, DD) = _
DDate
End If
If Model = 200 Then
R1500M200Count = R1500M200Count + 1
R1500M200(R1500M200Count, OP) = _
OPeration
R1500M200(R1500M200Count, SO) = _
Order
R1500M200(R1500M200Count, DD) = _
DDate
End If
If Model = 300 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 = 100 Then
R1700M100Count = R1700M100Count + 1
R1700M100(R1100M100Count, OP) = _
OPeration
R1700M100(R1700M100Count, SO) = _
Order
R1700M100(R1700M100Count, DD) = _
DDate
End If
If Model = 200 Then
R1700M200Count = R1700M200Count + 1
R1700M200(R1700M200Count, OP) = _
OPeration
R1700M200(R1700M200Count, SO) = _
Order
R1700M200(R1700M200Count, DD) = _
DDate
End If
If Model = 300 Then
R1700M300Count = R1700M300Count + 1
R1700M300(R1700M300Count, OP) = _
OPeration
R1700M300(R1700M300Count, SO) = _
Order
R1700M300(R1700M300Count, DD) = _
DDate
End If
End If
If Left(Item, 2) = "11" Then
If Model = 100 Then
R1100M100Count = R1100M100Count + 1
R1100M100(R1100M100Count, OP) = _
OPeration
R1100M100(R1100M100Count, SO) = _
Order
R1100M100(R1100M100Count, DD) = _
DDate
End If
If Model = 200 Then
R1100M200Count = R1100M200Count + 1
R1100M200(R1100M200Count, OP) = _
OPeration
R1100M200(R1100M200Count, SO) = _
Order
R1100M200(R1100M200Count, DD) = _
DDate
End If
If Model = 300 Then
R1100M300Count = R1100M300Count + 1
R1100M300(R1100M300Count, OP) = _
OPeration
R1100M300(R1100M300Count, SO) = _
Order
R1100M300(R1100M300Count, 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 SortData(R1100M100, R1100M100Count)
Call SortData(R1100M200, R1100M200Count)
Call SortData(R1100M300, R1100M300Count)
Call InsertData(R1300M100, R1300M100Count, _
Ref1300, 100, "100")
Call InsertData(R1300M200, R1300M200Count, _
Ref1300, 200, "200")
Call InsertData(R1300M300, R1300M300Count, _
Ref1300, 300, "300")
Call InsertData(R1500M100, R1500M100Count, _
Ref1500, 100, "100")
Call InsertData(R1500M200, R1500M200Count, _
Ref1500, 200, "200")
Call InsertData(R1500M300, R1500M300Count, _
Ref1500, 300, "300")
Call InsertData(R1700M100, R1700M100Count, _
Ref1700, 100, "100")
Call InsertData(R1700M200, R1700M200Count, _
Ref1700, 200, "200")
Call InsertData(R1700M300, R1700M300Count, _
Ref1700, 300, "300")
Call InsertData(R1100M100, R1100M100Count, _
Ref1100, 100, "100")
Call InsertData(R1100M200, R1100M200Count, _
Ref1100, 200, "200")
Call InsertData(R1100M300, R1100M300Count, _
Ref1100, 300, "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