Help with automating macro

C

Cam

Hi,

I have an Excel that track all the WIP in the system and trying to automate
placing the order# in the order cell to take away the time consuming manual
task.
I have a template sheet with No. column filled out. The raw data sheet with
raw data from the importing from Access that updated daily.

The intend is to look at the Model & Operation from the raw data sheet, then
start filling in Order# to the template sheet in the corresponding column I
to N based on the highest Oper order# first. H column is model number.
Criteria is to ignor (skip) any cell in column I to N with AS specified on
the template sheet. The sample data is below. There are 2 1300, 1500 and 1700
order# per No. Thanks

Template sheet1 before macro:
A H I J K L M N
NO MODEL 1300 1300 1500 1500 1700 1700
1000 100
1001 300 AS AS AS
1002 100 AS AS
1003 200
1004 300
1005 100

Raw data sheet2:
A B L O P
Order# Item Oper Ref Model
200201 123B1360-1107A 490 1300 200
200211 123B1360-1007A 490 1300 100
200260 123B1560-1107A 490 1500 200
200270 123B1360-1107A 490 1300 200
200213 123B1560-1007A 320 1500 100
200225 123B1760-1007A 320 1700 100
200200 123B1360-1203 310 1300 300
200224 123B1360-1203 200 1300 300
200265 123B1560-1007A 190 1500 100
200207 123B1760-1203 170 1700 300
200205 123B1560-1007A 150 1500 100
200217 123B1360-1203 150 1300 300
200256 123B1560-1007A 80 1500 100
200202 123B1760-1007A 30 1700 100
200206 123B1560-1207A 13 1500 300

Result after macro template sheet1:
A H I J K L M N
NO MODEL 1300 1300 1500 1500 1700 1700
1000 100 200211 200213 200265 200225 200202
1001 300 200200 AS AS AS 200207
1002 100 AS 200205 200256 AS
1003 200 200201 200270 200260
1004 300 200224 200217 200206
1005
 
J

Joel

I've worked on this about a yearr ago. What changed that required updates.
this was not an easy task to accomplish.
 
C

Cam

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
 
J

Joel

I think the change was pretty simple. I just had to make some minor changes
to the routine below

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 _
(.Rows(RowCount).Hidden = True)
RowCount = RowCount + 1
Loop

For LoopCount = 0 To (Count - 1)
Do While .Cells(RowCount, "I"). _
Offset(0, (2 * Ref) + MyOffset) <> ""

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 _
(.Rows(RowCount).Hidden = True)

RowCount = RowCount + 1
Loop
MyOffset = 0
End If
Loop
.Cells(RowCount, "I"). _
Offset(0, (2 * Ref) + MyOffset) = _
MyArray(LoopCount, SO)
.Cells(RowCount, "Q"). _
Offset(0, (2 * Ref) + MyOffset) = _
MyArray(LoopCount, OP)
Next LoopCount

End With

End Sub
 
J

Joel

I saw an error in the code. Try this instead

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 _
(.Rows(RowCount).Hidden = True)
RowCount = RowCount + 1
Loop

For LoopCount = 0 To (Count - 1)
Do While .Cells(RowCount, "I"). _
Offset(0, (2 * Ref) + MyOffset) <> ""

If MyOffset = 0 Then
MyOffset = 1
Else
RowCount = RowCount + 1
Do While (Not IsEmpty(.Cells(RowCount, "I")) And _
(.Cells(RowCount, "H") <> Model)) Or _
(.Rows(RowCount).Hidden = True)

RowCount = RowCount + 1
Loop
MyOffset = 0
End If
Loop
.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
End If
Next LoopCount

End With

End Sub
 
C

Cam

Joel,

I tried your latest revision, but it still skipping rows with Asc on the
column I and overwrite cells in column I thru N with Asc on it if there is no
Asc specified on column I.

Also, in the code I am wondering what is .Cells(RowCount, "Q"). _
referencing, Model?
 
J

Joel

I found the skipping problem. Not sure why it is over-writing. See if this
change solves both problems.

We were putting the operation number into columns O-T at one time. We
probably eliminated this option and didn't delete the line of code you are
lookig at. there are lots of places in the code that uses this operation
number including sort on this number.



Sub InsertData(ByRef MyArray() As Variant, _
Count, Ref, Model, InsertSheet)

With Sheets(InsertSheet)
RowCount = 2
MyOffset = 0
Do While (.Cells(RowCount, "H") <> Model) Or _
(.Rows(RowCount).Hidden = True)
RowCount = RowCount + 1
Loop

For LoopCount = 0 To (Count - 1)
Do While .Cells(RowCount, "I"). _
Offset(0, (2 * Ref) + MyOffset) <> ""

If MyOffset = 0 Then
MyOffset = 1
Else
RowCount = RowCount + 1
Do While (.Cells(RowCount, "H") <> Model) Or _
(.Rows(RowCount).Hidden = True)

RowCount = RowCount + 1
Loop
MyOffset = 0
End If
Loop
.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
End If
Next LoopCount

End With

End Sub
 
J

Joel

I found the over-writing problem. The code in the beginning was clearing the
ASC from the worksheet. Try this change. The code below is looking for ASC
not AS. either change the code to AS or change the worksheet to ASC.

from


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


to:


With Sheets(“100â€)
LastRowSh1 = _
.Cells(Rows.Count, "I").End(xlUp).Row
If LastRowSh1 <> 1 Then
Set DataRange = .Range(.Cells(2, "I"), _
.Cells(LastRowSh1, "X"))
For Each Cell In DataRange
If (Ucase(Cell) <> "ASC") And _
(.Rows(Cell.Row).Hidden = False) Then

cell.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 DataRange = .Range(.Cells(2, "I"), _
.Cells(LastRowSh2, "X"))
For Each Cell In DataRange
If (Ucase(Cell) <> "ASC") And _
(.Rows(Cell.Row).Hidden = False) Then

cell.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 DataRange = .Range(.Cells(2, "I"), _
.Cells(LastRowSh3, "X"))
For Each Cell In DataRange
If (Ucase(Cell) <> "ASC") And _
(.Rows(Cell.Row).Hidden = False) Then

cell.ClearContents
End If
Next Cell
End If
End With
 
C

Cam

Joel,

I ran the latest code and It gave me this error.

Run-time error '9':
Subscript out of range
 
J

Joel

which line is highlighted when you get the failure. Usually this is due to
the Worksheet name being wrong.

did the problem occur after putting the 1st change (sub InsertData) or the
2nd change (Fixing the over-writing problem)?
 
C

Cam

When I go to Debug, it is pointing to the first code clear data.
With Sheets(“700â€)
LastRowSh1 = _
.Cells(Rows.Count, "I").End(xlUp).Row
If LastRowSh1 <> 1 Then
Set DataRange = .Range(.Cells(2, "I"), _
.Cells(LastRowSh1, "X"))
For Each Cell In DataRange
If (UCase(Cell) <> "ASCO") And _
(.Rows(Cell.Row).Hidden = False) Then

Cell.ClearContents
End If
Next Cell
End If
End With

With Sheets(“800â€)
LastRowSh2 = _
.Cells(Rows.Count, "I").End(xlUp).Row
If LastRowSh2 <> 1 Then
Set DataRange = .Range(.Cells(2, "I"), _
.Cells(LastRowSh2, "X"))
For Each Cell In DataRange
If (UCase(Cell) <> "ASCO") And _
(.Rows(Cell.Row).Hidden = False) Then

Cell.ClearContents
End If
Next Cell
End If
End With

With Sheets(“900â€)
LastRowSh3 = _
.Cells(Rows.Count, "I").End(xlUp).Row
If LastRowSh3 <> 1 Then
Set DataRange = .Range(.Cells(2, "I"), _
.Cells(LastRowSh3, "X"))
For Each Cell In DataRange
If (UCase(Cell) <> "ASCO") And _
(.Rows(Cell.Row).Hidden = False) Then

Cell.ClearContents
End If
Next Cell
End If
End With

Then, I took out this part of the code and ran it, it gave me this error at
the InsertData.

Run-time error '1004':
Application-defined or object-defined error

Highlight in yellow is:
Do While (.Cells(RowCount, "H") <> Model) Or _
(.Rows(RowCount).Hidden = True)
 
J

Joel

First fgo back to your Virgin Workbook and make sure macro runs. The
original code you sent me had Sheets 100,200, 300. the new code you sent me
now has 700, 800, 900. I think you may need to add sheets 700, 800, 900.
 
C

Cam

Joel,

I did converse everything from 100, 200 and 300 to 700, 800 and 900
respectively and I did have a sheet for 700, 800 and 900 for each model when
I ran your latest code.
 
C

Cam

I also forgot to mention the original code you helped with a while back ran
fine except it is skipping all the entire rows where column I have ASC
specified.
 
J

Joel

Your double quotes around 700, 800, 900 are not double quotes. Look
carefully. they slant in opposite directions.
 
J

Joel

Replace the double quotes around 700, 800 and 900. You may changes to these
lines becuase I posted them as 100, 200, 300.
 
C

Cam

I changed the code to "700" etc.. This part work on but I still get the
second error in the InsertData part.
 
J

Joel

We have to fix the code the way it was originally in 2 places (see below).
Still not sure why it was skipping. Maybe the other fix (fixing the double
quotes) will also cure the skipping. If it still skips, then I think there
may be cells with spaces and no data. The code with clearcontents will also
remove the cells with just spaces in it. Right now I think this fix below
should fix everything.


from

Do While (.Cells(RowCount, "H") <> Model) Or _
(.Rows(RowCount).Hidden = True)


to
Do While (Not IsEmpty(.Cells(RowCount, "I")) And _
(.Cells(RowCount, "H") <> Model)) Or _
(.Rows(RowCount).Hidden = True)
 
C

Cam

Joel,

I almost got this to work. It is now filling in the empty cell data where it
is not specified as ASCO, but still one little problem.
If there any cell in column I is specified as "ASCO", it will not fill the
data for that row, but if there are no ASCO on column I cell, say, column J
to N, then it will filled in the data where there is no ASCO.

I am wondering if it is this line that cause this.
Do While (Not IsEmpty(.Cells(RowCount, "I")) And _
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA help w/ look & fill in data 20
Really Help with existing VBA code... 3
A Macro for copy with selection.. (please help me) 4
Help I need a macro or IF Statement 6
Help with Existing VBA code 1
Really need help with existing code? 1
Array Help 1
Data Returned Has Rounding Issues 4

Top