VBA / Macro Help Please

[Hmkzoo]

Thanks in advance this is driving me crazy!
I'm trying to create an automated ordering system based on inventory levels.
This is an inventory sheet of 59 items. I have it set to when the total for
a specific product falls underneath a specific level; it displays "order" or
"OK" using:

=IF(AJ3<2,"Order","OK")

The Problem...
I need to post only the items that appear with the "Order" status to another
sheet formatted for export into an existing Access DB. I'm far from an expert
using Macros, The only thing I could come up with is:

Private Sub Worksheet_Activate()

If Worksheets("Count").Range("AK3").Value = "Order" Then
Worksheets("Ordering Export Info").Range("A2").Value = 1 'ID Number
Worksheets("Ordering Export Info").Range("B2").Value = "Air Freshener"
'Product Description
Worksheets("Ordering Export Info").Range("D2").Value = 1 'Preset
Order Amount
Worksheets("Ordering Export Info").Range("E2").Value = Now 'Current Date
End If

If Worksheets("Count").Range("AK4").Value = "Order" Then
Worksheets("Ordering Export Info").Range("A3").Value = 2
Worksheets("Ordering Export Info").Range("B3").Value = "Alkaline"
Worksheets("Ordering Export Info").Range("D3").Value = 2
Worksheets("Ordering Export Info").Range("E3").Value = Now
End If

If Worksheets("Count").Range("AK5").Value = "Order" Then
Worksheets("Ordering Export Info").Range("A4").Value = 3
Worksheets("Ordering Export Info").Range("B4").Value = "Bleach"
Worksheets("Ordering Export Info").Range("D4").Value = 1
Worksheets("Ordering Export Info").Range("E4").Value = Now
End If

End Sub

This, for some reason only prints the first line on the second sheet. It is
not printing any of the other lines. The second and third If statements are
not working for some reason. The other problem with doing it like this is
that there would be gaps in between rows on the second sheet. I'm not sure if
that would affect the export of information to Access or not...Any Ideas???

 

[Don Guillett]

A simple looping macro should take care of this. So that I don't have to
recreate your data
If desired, send your file to my address below. I will only look if:
1. You send a copy of this message on an inserted sheet
2. You give me the newsgroup and the subject line
3. You send a clear explanation of what you want
4. You send before/after examples and expected results.

 

[JLatham]

(may be a duplicate post, once again system seems to be acting up)

First, I'm not sure about your printing first line of the second sheet only
issue. You might check the File --> Page Setup --> [Sheet] tab, "Print area"
setting to make sure it is cleared out and not limiting you to printing just
the first row or two of the sheet. That's assuming "print" means to a
printer, and not when importing into Access.

Now on to your coding problem...

There's some unanswered questions in your request, but I thought I'd give it
a go anyhow. BUT this won't work unless the answers to a couple of questions
I'll ask have "yes" answers, and you'll have to modify the code to set it up
properly.

Question #1: is there a column on the [Count] sheet that has the name of the
product in it? If YES, then use that column ID letter(s) as the value for
Const srcProductNameCol
in the actual code (I have it as "X" now)

Question #2: is there a column on the [Count] sheet that has the
number/quantity for the preset reorder value in it? If YES, then use that
column ID letter(s) as the value for
Const srcDefaultOrderQty
in the actual code (where I now use "Y")

If the answer to either of those questions is NO, quit reading now and take
Don Guillett up on his kind offer.

If both answers are Yes, then you should be able to modify and use this code
to achieve your goal of building a current list of things that need to be
ordered.

Make a copy of your workbook to test with. Open the copy and find your
current code, replace the code between the
Private Sub Worksheet_Activate()
....your present code
End Sub

statements. Then edit the code as needed (those two Const values I
mentioned) and give it a test by selecting any sheet in the workbook, and
then selecting the one that has the code associated with it, which I assume
is the [Ordering Export Info] sheet.

Here's the potential replacement code.

Const sourceSheetName = "Count"
'these all deal with the [Count] sheet
'change as required
'and this first one definitely needs to
'be changed: we assume that some column
'on this sheet contains the name of the
'item to be ordered, if one doesn't, then
'ALL BETS ARE OFF

'set this to the column ID that holds the
'product name on the [Count] sheet
Const srcProductNameCol = "X" ' must be changed
'need a column to determine the preset order
'quantity from also, again this should be
'on the [Count] sheet and you need to
'identify its column here
Const srcDefaultOrderQty = "Y" 'must be changed

Const srcOrderCol = "AK"

Dim sourceWS As Worksheet
Dim sourceListRange As Range
Dim anySourceCell As Range
Dim offset2ItemName As Integer
Dim offset2OrderQty As Integer

Const destSheetName = "Ordering Export Info"
Dim destWS As Worksheet
Dim destWSDataArea As Range
'these all reference columns on your
'[Ordering Export Info] sheet
Const destIDNumCol = "A"
Const itemNameCol = "B"
Const itemOrderQtyCol = "D"
Const itemOrderDateCol = "E"

Dim orderNumber As Integer
Dim destRow As Long
Dim destLastRow As Long

Set sourceWS = ThisWorkbook.Worksheets(sourceSheetName)
Set sourceListRange = sourceWS.Range(srcOrderCol & "3:" & _
sourceWS.Range(srcOrderCol & Rows.Count).End(xlUp).Address)
offset2ItemName = Range(srcProductNameCol & 1).Column - Range(srcOrderCol
& 1).Column
offset2OrderQty = Range(srcDefaultOrderQty & 1).Column - Range(srcOrderCol
& 1).Column

Set destWS = ThisWorkbook.Worksheets(destSheetName)
'need to clear out any old information on the sheet
destRow = 2 ' first row to write to, initialized
destLastRow = destWS.Range(destIDNumCol & Rows.Count).End(xlUp).Row
If destLastRow < destRow Then
destLastRow = destRow
End If
Set destWSDataArea = destWS.Range(destIDNumCol & destRow & ":" & _
Cells(destLastRow, destWS.UsedRange.Columns.Count).Address)
'this will speed things up
Application.ScreenUpdating = False
'and now to get down to work
destWSDataArea.ClearContents
Set destWSDataArea = Nothing
'look for "Order" in column AK of the [Count] sheet
orderNumber = 1 ' initialize
'find out what row to put the data into on the
'destination sheet
destLastRow = destWS.Range(destIDNumCol & _
Rows.Count).End(xlUp).Row + 1
If destLastRow < destRow Then
destLastRow = destRow
End If
'do the actual work of finding "Order" in AK# on
'the [Count] sheet and then making a record on the
'[Ordering Export Info] sheet for it
For Each anySourceCell In sourceListRange
'the Ucase(Trim will remove leading/trailing spaces and
'convert the phrase to UPPERCASE so testing should be
'more positive for you
If Ucase(Trim(anySourceCell.Value)) = "ORDER" Then
destWS.Range(destIDNumCol & destLastRow) = orderNumber
destWS.Range(itemNameCol & destLastRow) = _
anySourceCell.Offset(0, offset2ItemName)
destWS.Range(itemOrderQtyCol & destLastRow) = _
anySourceCell.Offset(0, offset2OrderQty)
destWS.Range(itemOrderDateCol & destLastRow) = Now()
orderNumber = orderNumber + 1 ' for next one
destLastRow = destLastRow + 1 ' for next entry
End If
Next
'housekeeping
Set sourceListRange = Nothing
Set sourceWS = Nothing
Set destWS = Nothing