![]() |
Old VBA code modification help
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 |
All times are GMT +1. The time now is 04:13 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com