Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
Cam Cam is offline
external usenet poster
 
Posts: 165
Default 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

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
modification to this code James Excel Discussion (Misc queries) 0 March 23rd 09 09:20 PM
Code modification? fpd833 Excel Programming 2 September 21st 07 04:52 PM
Code modification help please Tom Excel Programming 2 April 10th 07 06:44 PM
Modification in the CODE to HIDE rows and columns that start with ZERO (code given) Thulasiram[_2_] Excel Programming 4 September 26th 06 04:15 AM
Modification to code Peter Atherton Excel Programming 1 September 23rd 03 07:36 PM


All times are GMT +1. The time now is 12:15 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"