Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Westi on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Updating cell values

Status
Not open for further replies.

iisailor

Programmer
Mar 10, 2009
2
GB
Hi everyone,
Hopefully you can help me, im trying to create a macro that will read through a spredsheet and everytime it finds the value in column F to be greater than 0 it will copy and paste this row into another sheet.Here, columns A,B & C of the copied row will be checked against columns B,C & D of the existant rows in the sheet. If there is a match then the value for column F of the copied row (this is a stock quantity) will be compared against the value for the corresponding cell in the selected row. Basically its a stock check from an order form so that before an order is sent this will check to see if parts are in stock and then update the relevant cells.
My code is as follows:

Option Explicit

Sub StockCheck()

Dim PartSearch As Integer
Dim Last As Long
Dim b As Long

'On Error GoTo Err_Execute

'Sheets("Frames").Activate
Last = ActiveSheet.UsedRange.Rows.Count

PartSearch = 2
For b = 1 To Last

'While Len(Range("B" & CStr(PartSearch)).Value) <= Last
If Range("F" & CStr(PartSearch)).Value > 0 Then

Rows(CStr(PartSearch) & ":" & CStr(PartSearch)).Select
'Set Source = Nothing
'Set Source = Range("A:C" & "F")
Selection.Copy
ActiveSheet.Paste Destination:=Workbooks("Stocking System").Worksheets("Stock Items").Cells(2100, 1)
End If

Application.Workbooks("Stocking System").Activate
Application.Sheets("Stock Items").Activate
If Range("B" & CStr(PartSearch)).Value = Range("A2100") Then
If Range("C" & CStr(PartSearch)).Value = Range("B2100") Then
If Range("D" & CStr(PartSearch)).Value = Range("C2100") Then

If Range("L" & CStr(PartSearch)).Value > Range("F2100").Value Then
Range("L").Value = Range("L").Value - Range("F2100").Value
Range("F2100").Value = 0
End If
Else
If Range("L" & CStr(PartSearch)).Value < Range("F2100").Value Then
Range("F2100").Value = Range("F2100").Value - Range("L").Value
Range("L").Value = 0
Else
If Range("L" & CStr(PartSearch)).Value = Range("F2100").Value Then
Range("F2100").Value = 0
Range("L").Value = 0
End If
End If

End If
End If
End If
'Err_Execute:
'MsgBox "An error occurred."

Cells.Range("F2100").Copy
'Workbooks("Parts Lists").Activate
'Sheets("Frames").Select
ActiveSheet.Paste Destination:=Workbooks("Parts Lists").Worksheets("1025 - Magnet Frames").Cells(12)
Application.CutCopyMode = False
PartSearch = PartSearch + 1
Next b
'Wend

End Sub


With this code i get a Method 'Range' of object '_Global' failed error so can anyone advise on the error as well as whether or not my code is on the right track.
 




Hi,

With this code i get a Method 'Range' of object '_Global' failed error
Which statement failed?

Skip,
[glasses]Don't let the Diatribe...
talk you to death![tongue]

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Try putting activesheet. or sheets("Stock Items"). in front of all your range(..) objects.

_________________
Bob Rashkin
 



Partsearch = 2

must be INSIDE the for...next loop.

Otherwise it continues to incriment.

Skip,
[glasses]Don't let the Diatribe...
talk you to death![tongue]

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 



ignore my last comment.

Skip,
[glasses]Don't let the Diatribe...
talk you to death![tongue]

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Hey guys, sorry ive managed to fix the problem, i cant actually remember now how i got it but nonetheless the help is greatly appreciasted.
Going through the code though can anyone see why the row 2100 in Stock Items gets deleted everytime?? Also when pasting back to the first sheet does anyone know how i can paste into the selected cell in the row. so far the code pastes it into column L okay, but only ever on the first row.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top