macro not posting data

[jwset]

I got a sheet1 that has the following information;


A BCD E F
16 Item Number Discrip. Asking Price Sold Price
17 BK-011 Test $5.00 $4.50
18 JK-112 Test2 $15.00 $15.00

The discription and asking price are pulled from sheet2 that has the information on it.

I want to have it take the sold price and fill it in on sheet2 where it got the information.
Into the column that holds the empty cell so I dont have to maually fill in the sold price is column E
so I need it to search till it finds the item number then put in the sold price for each item sold in the list off sheet1.

the lay out for sheet2 is

A= item number B= Discription C= Owners Name D=Asking Price E= Sold Price and
so on have other cells but they have formulas to do the rest.

I got the code to run but nothing is ever put into the Sold Price on sheet2 Any idea what I am missing?

here is my code
Dim ItemNumber
Dim SoldPrice
Dim Item2
'
Workbooks(1).Activate
Sheets("Sheet1&quot.Select
Range("A17&quot.Select
ItemNumber = ActiveCell
SoldPrice = ActiveCell.Offset(0, 4).Value

Do Until ItemNumber = ""
Workbooks(1).Activate
Range("A6&quot.Select
Item2 = ActiveCell

Do Until Item2 = ""
If Item2 = ItemNumber Then
GoTo SETITEM
End If
ActiveCell.Offset(1, 0).Select
Item2 = ActiveCell
Loop
SETITEM:
ActiveCell.Offset(0, 5).FormulaR1C1 = SoldPrice
Application.CutCopyMode = False
ActiveCell.Rows("1:1&quot.EntireRow.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Loop


End Sub



Thank you for your help.

J.W.

 

[bandit600]

J.W.

After only a quick scan, I can't see where you select sheet 2 before pasting. In which case is it overwriting the asking price on sheet 1?

There could be more to it, but does this help?

bandit600

 

[jwset]

I added the call to sheet 2 but still no luck getting it to post the data.

Do Until ItemNumber = ""
Workbooks(1).Activate
Sheets("Sheet2&quot.Select
Range("A6&quot.Select
Item2 = ActiveCell

this is where I put it I think this is correct location.

J.W.

 

[Nikita6003]

Hi jwset,

this could be just my ignorance or the cold I've got at the moment *sneeze* but can't you revert to a VLOOKUP on sheet2? It would seem to me if your ITEM-NUMBER is unique, the description and asking price can be vlookupped without any problmens ;-)

Assuming you've got your list starting from cell A6 on sheet2 try using

=VLOOKUP(A6, "Sheet1!A17:F24", 2, FALSE)

to find the descrpition. If you need all three columns for your description just concatenate the VLOOKUP results.

The reason the code's not working probably lies in this bit of your code: you're mixing your worksheets up

   Workbooks(1).Activate
    Sheets("Sheet1").Select
    Range("A17").Select
    ItemNumber = ActiveCell
    SoldPrice = ActiveCell.Offset(0, 4).Value

    Do Until ItemNumber = ""
    Workbooks(1).Activate
    Range("A6").Select
    Item2 = ActiveCell

Now the code activates the workbook (that's only necessary if the macro is in a different workbook than your lists, BTW. If they're in one and the same place, you could try using

ThisWorkbook

instead. Much easier to read ;-)). It the activates Sheet1 and gets the first ItemNumber off of cell A17. It gets the price for this item from cell E17 (offset of 4 columns)
You the start a DO UNTIL loop: you -
activate ThisWorkbook
Select cell A6 - BUT because you've NOT activated sheet2 - which is where you WANt to be looking - your code assumes that you mean cell A6 on Sheet1.

Add this line:

ThisWorkbook.Sheets(2).Activate

before the line

Range("A6").Select

and it should pick up the second item code from sheet2 rather than sheet1


Hope this all helps ... if not, let us know ;-)

Cheers
Nikki

 

[jwset]

Ok I tried yur suggestions but with no luck. It still looks like it runs but nothing happens on sheet2. On sheet on it goes down the list to the end but thats all that happens like it is looking at the sold items but not doing any thing with them and I get no errors so am lost. I am just learning VB so really not sure on the codes and layout.
I know about the VLOOKUP function but really dont want to add a formula to each cell where the sold price would be if and when it gets sold. Would rather the sold price be put in when it is sold from the sales sheet.

here is my code now; (I did like you said added ThisWorkbook) does look better.

Dim ItemNumber
Dim SoldPrice
Dim Item2
'
ThisWorkbook.Sheets(1).Activate
Range("A17&quot.Select
ItemNumber = ActiveCell
SoldPrice = ActiveCell.Offset(0, 4).Value
Do Until ItemNumber = ""

ThisWorkbook.Sheets(2).Activate
Range("A6&quot.Select
Item2 = ActiveCell

Do Until Item2 = ""
If Item2 = ItemNumber Then
GoTo SETITEM
End If
ActiveCell.Offset(1, 0).Select
Item2 = ActiveCell
Loop

SETITEM:
ActiveCell.Offset(0, 5).FormulaR1C1 = SoldPrice
Application.CutCopyMode = False
ActiveCell.Rows("1:1&quot.EntireRow.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Loop


End Sub

Thank you for all your help BTW I sure hope you maybe know what I got wrong I sure dont.

J.W.

 

[rmikesmith]

J.W.

Using the data setup you presented, the following procedure should do what you want [Note - I assumed a header on sheet2 at row 1]:

Sub UpdateSoldPrice()
Const Sh1_HeaderRow = 16
Const Sh2_HeaderRow = 1
Dim LastUsedRow As Long
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim SearchRng As Range
Dim Result As Variant
Dim i As Long

  Application.ScreenUpdating = False
  Set wks1 = ThisWorkbook.Worksheets("Sheet1")
  Set wks2 = ThisWorkbook.Worksheets("Sheet2")
  
  With wks2
    LastUsedRow = .Cells(65536, 1).End(xlUp).Row
    If LastUsedRow = Sh2_HeaderRow Then Exit Sub
    Set SearchRng = .Range(.Cells(2, 1), .Cells(LastUsedRow, 1))
  End With
  
  With wks1
    LastUsedRow = .Cells(65536, 1).End(xlUp).Row
    If LastUsedRow = Sh1_HeaderRow Then Exit Sub
    
    For i = Sh2_HeaderRow + 1 To LastUsedRow
      If .Cells(i, 6).Value <> &quot;&quot; Then
        Result = Application.Match(.Cells(i, 1).Text, SearchRng, 0)
        If Not IsError(Result) Then
          wks2.Cells(CLng(Result) + 1, 5).Value = .Cells(i, 6).Value
        End If
      End If
    Next i
  End With
  Application.ScreenUpdating = True
  
End Sub

This incorporates Nikki's suggestion of using a lookup function, which far and away beats a VBA loop for speed. The other thing to take note of is that I do not select sheets and cells, which also slows execution condiderably. Let us know how this works.

Regards,
Mike

 

[jwset]

Yep that got it working. Thank you so very much.
I appreciate all your help.

J.W.