Macro to Compare and copy info based on a serial Number

B

Bennyton

New Member
Joined
Apr 13, 2011
Messages
20
Hi all

I have a little bit of trouble with a macro.

I have 3 worksheets.

1 is a list of products in "Stop Mode"
2 is a list of products that are in "Go mode"
3 is a list of serials and next to them are definitions saying STOP and GO...

so what I want to do, is run a macro that will check worksheet 3,

so that IF column b has a value of "STOP",

then it will get the the serial next to it in column A,

and search through worksheet 2,

when it finds its match, it will cut that row,

and paste it at the bottom of worksheet 1.

it will then loop again to do the next one.... so the next one in worksheet 3 with a STOP Value.


It's rattling my brain at the moment, thanks for your help.
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Sort by date Sort by votes
Hi, try this procedure. Hope it helps.

Code: 
Sub CopyEntireRow()

'probably you have to change those names:
SheetName1 = "Stop Mode"
SheetName2 = "Go mode"
SheetName3 = "Sheet3" ' name of the 3rd sheet
SerialCol = "A" 'column of 1st and 2nd sheets with serial
'values of cells in B column od 3rd sheet:
crit1 = "STOP"
crit2 = "GO"

Dim CellR As Range
Dim strName As String
Dim Arr() As String


lastRow3 = Sheets(SheetName3).Range("A1").End(xlDown).Row

For i = 1 To lastRow3

    lastRow2 = Sheets(SheetName2).Range("A1").End(xlDown).Row
    lastRow1 = Sheets(SheetName1).Range("A1").End(xlDown).Row
    
    If Sheets(SheetName3).Cells(i, "B").Value = crit1 Then
        For j = 1 To lastRow2
            If Sheets(SheetName2).Cells(j, SerialCol).Value = Sheets(SheetName3).Cells(i, "A").Value Then
                Sheets(SheetName2).Rows(j).EntireRow.Cut Sheets(SheetName1).Range(lastRow1 + 1 & ":" & lastRow1 + 1)
                Sheets(SheetName2).Rows(j).EntireRow.Delete
                
            End If
        Next j
    ElseIf Sheets(SheetName3).Cells(i, "B").Value = crit2 Then
        For j = 1 To lastRow1
            If Sheets(SheetName1).Cells(j, SerialCol).Value = Sheets(SheetName3).Cells(i, "A").Value Then
                Sheets(SheetName1).Rows(j).EntireRow.Cut Sheets(SheetName2).Rows(lastRow2 + 1 & ":" & lastRow2 + 1)
                Sheets(SheetName1).Rows(j).EntireRow.Delete
            End If
        Next j
    Else
        MsgBox "Empty cell:" & Sheets(SheetName1).Range("B" & i).Address
    End If
    
Next i

End Sub
 
Upvote 0
Thanks a million for the reply P. , but I'm finding it hard to get this working, maybe in this context it may make more sense to you?
Sub StopFind()
'
'
'
Sheets("combine450_60 level").Select
Columns("A:D").Select
Selection.ClearContents
Windows("60 STOP macro.xls").Activate
Range("A:A,G:G").Select
Range("G1").Activate
Selection.Copy
Windows("MATT NOT SAP MACRO1.xls").Activate
Range("A1").Select
ActiveSheet.Paste
Windows("450 STOP macro.XLS").Activate
Range("A:A,G:G").Select
Range("G1").Activate
Application.CutCopyMode = False
Selection.Copy
Windows("MATT NOT SAP MACRO1.xls").Activate
Range("C1").Select
ActiveSheet.Paste
'
'Test to search for stop statuses in "combine450_60 level"
'when it finds a stop status, it compares the serial number next to it, to those in column A in the WIP work sheet
'if it finds a match, it will copy and paste that column into the "stop sap or matt" sheet,
'and delete the row from the WIP sheet
SerialCol = "A"
SerialCol1 = "C"
crit1 = "STOP"

Dim CellR As Range
Dim strName As String
Dim Arr() As String


lastRow3 = Sheets("combine450_60 level").Range("A1").End(xlDown).Row

For i = 1 To lastRow3

lastRow2 = Sheets("WIP").Range("A1").End(xlDown).Row
lastRow1 = Sheets("stop sap or matt").Range("A1").End(xlDown).Row
lastRow4 = Sheets("combine450_60 level").Range("C1").End(xlDown).Row

If Sheets("combine450_60 level").Cells(i, "B").Value = crit1 Then
For j = 1 To lastRow2
If Sheets("WIP").Cells(j, SerialCol).Value = Sheets("combine450_60 level").Cells(i, SerialCol).Value Then
Sheets("WIP").Rows(j).EntireRow.Cut Sheets("stop sap or matt").Range(lastRow1 + 1 & ":" & lastRow1 + 1)
Sheets("WIP").Rows(j).EntireRow.Delete

End If
Next j
ElseIf Sheets("combine450_60 level").Cells(i, "D").Value = crit1 Then
For j = 1 To lastRow4
If Sheets("WIP").Cells(j, SerialCol).Value = Sheets("combine450_60 level").Cells(i, SerialCol1).Value Then
Sheets("WIP").Rows(j).EntireRow.Cut Sheets("stop sap or matt").Rows(lastRow2 + 1 & ":" & lastRow2 + 1)
Sheets("WIP").Rows(j).EntireRow.Delete
End If
Next j

End If

Next i

End Sub
Click to expand...

so in combine450_ 60 levels (Sheet 3) there are 4 columns in worksheet 3, a is a serial for type 1, and b is type 1's status, column c is serial for type 2, and D is type 2's status.


I need to get the ones with a stop status, check if the serial matches in "WIP" (worksheet 2) and if it matches, paste that row into "stop sap or matt" (Sheet 1)


Again thanks again so much for your help.
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Question Question
An idea on handling serial numbers?
Replies
5
Views
352
Micron
M
J
  • Question Question
Using Sheets().Select in a Worksheet_Activate() macro
2
Replies
10
Views
471
jdun
J
G
  • Solved
Help needed with simple macro
2
Replies
15
Views
211
MARK858
MARK858
M
  • Question Question
I need help with VBA/macro script to collect user input and fill cells
Replies
4
Views
558
mumps
mumps
Q
  • Question Question
Macro needed to insert 4 rows in table, copy data from above, copy data from another sheet and paste special (transpose values) to those new rows...re
Replies
1
Views
375
sijpie
sijpie

Forum statistics

Threads
1,224,522
Messages
6,179,297
Members
452,903
Latest member
Knuddeluff

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top