Visual Basic Help

[katiekatiesue]

Hello,

I am looking for help with a macro. Here's the basics (what I want it to do):

-The macro only works out of one workbook, with 3 worksheets, WIP_Watch Old, WIP_Watch New, and Stocked. Column headings for these worksheets include order number, part number, quantity, description, etc... but I'm only concerned with order number

-I want the macro to find and compare order numbers from WIP_Watch Old to WIP_Watch New. When a match is found, nothing needs to happen but when an order from WIP_Watch Old is NOT found on WIP_Watch New, then I want to copy the row containing the order number (columns A through W) from WIP_Watch Old.

-Next, I want to go to the worksheet called Stocked and insert a row at the top (under the column headings, so row 2), and paste the information copied from WIP_Watch Old. I then want to go to column W of this row and insert the date the copy is made.

-I need the above process to loop through the entire list of order numbers.

I have a macro started, but I've gotten stuck. Anyone think they can offer some help? The macro (called ToStock) is below.

Thanks.

Sub ToStock()

Dim Order As String 'Order Number
Dim OrderCol As Integer 'PO Column Number
Dim PrevRow As Integer 'Row number of the previous file
Dim CurrRow As Integer 'Row number of the current file


'Find Column locations in file
Cells(1, 1).Select
For i = 1 To 50
ColHeaders = Cells(1, i)
Select Case ColHeaders
Case "Order"
OrderCol = i
End Select
Next

CurrRow = 2

Do
Worksheets("WIP_Watch New").Activate

'Get the Order Number to compare to the previous WIP
Order = Cells(CurrRow, OrderCol)

PrevRow = 2


'This loop keeps going until the Order Number and Work Center are equal

Do
Worksheets("WIP_Watch Old").Activate

'Does the check to see if the Order Number matches. When a match is not found, the entire row (A-W) containing that order number is copied.
If Order <> Cells(PrevRow, OrderCol) Then
Worksheets("WIP_Watch Old").PrevRow.Copy

'Pastes Stocked Order Numbers to Stocked Worksheet

Worksheets("Stocked").Activate
ActiveCell.Offset(-20, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
ActiveCell.Range("A1:W1").Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(0, 22).Range("A1").Select
ActiveCell.FormulaR1C1 = "=TODAY()"

End If

'Increment the row

PrevRow = PrevRow + 1

Loop While Cells(PrevRow, OrderCol) <> ""

Worksheets("WIP_Watch New").Activate

'Increment the row number for the current file

CurrRow = CurrRow + 1

Loop While Cells(CurrRow, OrderCol) <> ""

End Sub

 

[ravishankar]

Hi
Paste the following codes in the macro window ( Alt F11). replace sheet1 , 2 and 3 with actual names.

Sub ttt()
d = 2
x = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
y = Worksheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row
For a = 1 To x
Cells(1, 10) = "=iserror(match(A" & a & ",Sheet2!A1:A" & y & ",0))"
If Cells(1, 10) = True Then
Rows(a).Copy
Worksheets("sheet3").Rows(d).PasteSpecial
d = d + 1
Cells(d, 24) = Now()
End If
Next a
End Sub

Run the macro. Order nos. in Col A which do not match with second sheet will be collated in sheet 3 with time of copying in col X.
Ravi

 

[brian.wethington]

Welcome to the Board!

does something like this work for you?

Sub Test()
Dim Src1 As Worksheet, Src2 As Worksheet, Dst As Worksheet, LstRw1 As Long, LstRw2
Dim c1 As Range, c2 As Range, Col1 As Long, Col2 As Long, Rng1 As Range, Rng2 As Range
Dim copyrow As Long, Ce As Range

Set Src1 = Sheets("WIP_Watch Old")
Set Src2 = Sheets("WIP_Watch New")
Set Dst = Sheets("Stocked")
With Src1.Range("1:1")
    Set c1 = .Find(What:="Order", After:=Cells(1, 1), SearchOrder:=xlByColumns, SearchDirection:=xlNext)
End With
With Src2.Range("1:1")
    Set c2 = .Find(What:="Order", After:=Cells(1, 1), SearchOrder:=xlByColumns, SearchDirection:=xlNext)
End With
If c1 Is Nothing Or c2 Is Nothing Then Exit Sub
Col1 = c1.Column
Col2 = c2.Column
LstRw1 = Src1.Cells(Rows.Count, Col1).End(xlUp).Row
LstRw2 = Src2.Cells(Rows.Count, Col2).End(xlUp).Row
Set Rng1 = Src1.Range(Cells(2, Col1), Cells(LstRw1, Col1))
Set Rng2 = Src2.Range(Cells(2, Col2), Cells(LstRw2, Col2))
For Each Ce In Rng1
    If WorksheetFunction.CountIf(Rng2, Ce.Value) > 0 Then
        copyrow = Ce.Row
        Dst.Rows("2:2").Insert
        Src1.Range(Cells(copyrow, "A"), Cells(copyrow, "W")).Copy Dst.Range("A2")
    End If
Next Ce

End Sub

 

[katiekatiesue]

Ravi,

I think your code might be close, but every time it compares a new order number it is asking me to open up a new file and select a worksheet from that file. I just want to use the active file.


Brian,

I am getting an error in your code at lines:

Set Rng1 = Src1.Range(Cells(2, Col1), Cells(LstRw1, Col1))
Set Rng2 = Src2.Range(Cells(2, Col2), Cells(LstRw2, Col2))

 

[brian.wethington]

Brian,

I am getting an error in your code at lines:

Set Rng1 = Src1.Range(Cells(2, Col1), Cells(LstRw1, Col1))
Set Rng2 = Src2.Range(Cells(2, Col2), Cells(LstRw2, Col2))

Sorry about that, I got in a hurry and forgot about qualifying I suppose

Try this:

Sub Test()
Dim Src1 As Worksheet, Src2 As Worksheet, Dst As Worksheet, LstRw1 As Long, LstRw2
Dim c1 As Range, c2 As Range, Col1 As Long, Col2 As Long, Rng1 As Range, Rng2 As Range
Dim copyrow As Long, Ce As Range

Set Src1 = Sheets("WIP_Watch Old")
Set Src2 = Sheets("WIP_Watch New")
Set Dst = Sheets("Stocked")
With Src1.Range("1:1")
    Set c1 = .Find(What:="Order", After:=Cells(1, 1), SearchOrder:=xlByColumns, SearchDirection:=xlNext)
End With
With Src2.Range("1:1")
    Set c2 = .Find(What:="Order", After:=Cells(1, 1), SearchOrder:=xlByColumns, SearchDirection:=xlNext)
End With
If c1 Is Nothing Or c2 Is Nothing Then Exit Sub
Col1 = c1.Column
Col2 = c2.Column
LstRw1 = Src1.Cells(Rows.Count, Col1).End(xlUp).Row
LstRw2 = Src2.Cells(Rows.Count, Col2).End(xlUp).Row
With Src1
    Set Rng1 = Src1.Range(.Cells(2, Col1), .Cells(LstRw1, Col1))
End With
With Src2
    Set Rng2 = .Range(.Cells(2, Col2), .Cells(LstRw2, Col2))
End With
For Each Ce In Rng1
    If WorksheetFunction.CountIf(Rng2, Ce.Value) > 0 Then
        copyrow = Ce.Row
        Dst.Rows("2:2").Insert
        With Src1
            .Range(.Cells(copyrow, "A"), .Cells(copyrow, "W")).Copy Dst.Range("A2")
        End With
    End If
Next Ce

End Sub

 

[katiekatiesue]

Brian - Awesome. Got it to work with one change

If WorksheetFunction.CountIf(Rng2, Ce.Value) = 0

When the formula was:

If WorksheetFunction.CountIf(Rng2, Ce.Value) > 0

it was copying every order number that matched. Works great now!

Thanks again. This was a HUGE help.

 

[brian.wethington]

LOL, I missed your capitalized, bolded, colored and circled NOT in your first post. Glad you figured it out and it worked for your puposes.