Visual Basic Help

katiekatiesue

New Member
Joined
Aug 1, 2007
Messages
3
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
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

ravishankar

Well-known Member
Joined
Feb 23, 2006
Messages
3,566
Hi
Paste the following codes in the macro window ( Alt F11). replace sheet1 , 2 and 3 with actual names.

Code:
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

Well-known Member
Joined
Jul 20, 2006
Messages
1,739
Welcome to the Board!

does something like this work for you?

Code:
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

New Member
Joined
Aug 1, 2007
Messages
3
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

Well-known Member
Joined
Jul 20, 2006
Messages
1,739
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:

Code:
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

New Member
Joined
Aug 1, 2007
Messages
3
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

Well-known Member
Joined
Jul 20, 2006
Messages
1,739
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.
 

Forum statistics

Threads
1,181,053
Messages
5,927,852
Members
436,573
Latest member
CMR237

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
Top