[RESOLVED] Repeating Macro..Please Help

[muzamilsumra]

Dear Friends,

I have a simple scenario..let me just give you the details of what i got and what i want to do...

I have two excel workbooks which are open...
Book1

PARTNO	DESCRIPTION	BRAND	QTY
12345	TEST 1	BRAND 1	4566
12346	TEST 2	BRAND 2	566
12347	TEST 3	BRAND 3	235
12348	TEST 4	BRAND 4	568
12349	TEST 5	BRAND 5	56
12350	TEST 6	BRAND 6	122

Book2

PARTNO	DESCRIPTION	BRAND	QTY
12345	TEST 1	BRAND 1	0
12346	TEST 2	BRAND 2	0
12347	TEST 3	BRAND 3	0
12348	TEST 4	BRAND 4	0
12349	TEST 5	BRAND 5	0
12350	TEST 6	BRAND 6	0

I Have The Follwoing macro which basically switches from book1 to book2, searches for the partno, description and brand from book1, when an exact match of all three columns is found in book2, it copies the qty from book1 and adds it up to the value in book2, swicthes back to book1, fills the cell with green color if a match is found and continues to the next row, if no match is found then it switches back to book1 and continues to the next cell without highlighting the previous cell.

Option Explicit
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+Shift+M
'
   Dim ws As Worksheet
    Dim PFound As Range
    Dim DFound As Range
    Dim BFound As Range
    Dim strName As String
    Dim cnt As Integer
    Dim Stock As Integer
    Dim PartNo As String
    Dim Description As String
    Dim BookName As String
    Dim Brand As String
    Dim CurrentBookName As String
    

CurrentBookName = ActiveWindow.Caption
PartNo = Range("A" & ActiveCell.Row)
Description = Range("b" & ActiveCell.Row)
Brand = Range("C" & ActiveCell.Row)
BookName = InputBox("Enter Book Name!")

    On Error Resume Next
    strName = InputBox("What Name?")
    If strName = "" Then Exit Sub
    Windows(BookName).Activate
    For Each ws In Worksheets
        With ws.UsedRange
            Set PFound = .Find(What:=PartNo, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole)
            Set DFound = .Find(What:=Description, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole)
            Set BFound = .Find(What:=Brand, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole)
            If Not PFound Is Nothing Then
                If Not DFound Is Nothing Then
                    If Not BFound Is Nothing Then
                        Application.GoTo BFound, True
                        Application.GoTo DFound, True
                        Application.GoTo PFound, True
                        If Range("A" & ActiveCell.Row).Value = PartNo And Range("B" & ActiveCell.Row).Value = Description And Range("C" & ActiveCell.Row).Value = Brand Then
                        Windows(CurrentBookName).Activate
                        
                        Stock = Range("D" & ActiveCell.Row).Value
                        Range("A" & ActiveCell.Row).Cells.Interior.Color = vbGreen
                        Windows(BookName).Activate
                        Range("D" & ActiveCell.Row).Value = Range("D" & ActiveCell.Row).Value + Stock
                        Windows(CurrentBookName).Activate
                        Range("A" & ActiveCell.Row + 1).Select
                        Else
                        Windows(CurrentBookName).Activate
                        Range("A" & ActiveCell.Row + 1).Select
                        End If
                        Exit Sub
                    End If
                End If
            End If
        End With
    Next ws
    On Error GoTo 0
    Windows(CurrentBookName).Activate
    Range("A" & ActiveCell.Row + 1).Select
End Sub

The whole code is working charms, but the only problem is that i have to press the macro key combination everytime i want to do a search for an item.

My question is how should i use a do while or do until loop on this code so that when i press the macros key combination only once? That is it will start from the first row to the sixth row in the tables above.

Any help will be appreciated, and i hope i have explained well enough.

[vbfbryce]

something like:

Sub compare2()
    Dim wb1 As Workbook
    Dim ws1 As Worksheet
    Dim wb2 As Workbook
    Dim ws2 As Worksheet
    Dim lastRow As Long
    Dim j As Long
    
    Set wb1 = Workbooks("wb1.xlsx") 'change name
    Set ws1 = wb1.Worksheets(1) 'first worksheet
    Set wb2 = Workbooks("wb2.xlsx") 'change name
    Set ws2 = wb2.Worksheets(1) 'first worksheet
    
    lastRow = ws1.Range("a" & Rows.Count).End(xlUp).Row
    'find the bottom of the data in workbook1
    
    For j = 2 To lastRow
        'do your compare stuff
    Next j
    
End Sub

[muzamilsumra]

Thank you for the reply vbfbryce, i have done that for next loop too, but the exit sub breaks the whole sub which prevents it from reapeating the macro. If i omit the exit sub from the code then it starts skipping lines.

[westconn1]

just a guess
try changing exit sub to exit for

[muzamilsumra]

ok i tried changing the exit sub to exit for, now it is skipping 1 row, for example i start the macro by selecting row1 of book1, it will highlight cell A1 skip A2 highlight A3 skip A4 and so forth and in book2 it will add up all the values in cell D1 only.

book1 looks like this.
Partno description brand qty
12345 test 1 brand 1 4566
12346 test 2 brand 2 566
12347 test 3 brand 3 235
12348 test 4 brand 4 568
12349 test 5 brand 5 56
12350 test 6 brand 6 122

book2 looks like this
Partno description brand qty
12345 test 1 brand 1 4857
12346 test 2 brand 2 0
12347 test 3 brand 3 0
12348 test 4 brand 4 0
12349 test 5 brand 5 0
12350 test 6 brand 6 0

[westconn1]

post the code as you currently have it

[muzamilsumra]

Option Explicit
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+Shift+M
'
   Dim ws As Worksheet
    Dim PFound As Range
    Dim DFound As Range
    Dim BFound As Range
    Dim strName As String
    Dim cnt As Integer
    Dim Stock As Integer
    Dim PartNo As String
    Dim Description As String
    Dim BookName As String
    Dim Brand As String
    Dim CurrentBookName As String
    

CurrentBookName = ActiveWindow.Caption
PartNo = Range("A" & ActiveCell.Row)
Description = Range("b" & ActiveCell.Row)
Brand = Range("C" & ActiveCell.Row)
'BookName = InputBox("Enter Book Name!")
BookName = UserForm1.TextBox1.Text
If BookName = "" Then
UserForm1.Show
End If
For cnt = 0 To 10
    On Error Resume Next
    Windows(BookName).Activate
    For Each ws In Worksheets
        With ws.UsedRange
            Set PFound = .Find(What:=PartNo, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole)
            Set DFound = .Find(What:=Description, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole)
            Set BFound = .Find(What:=Brand, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole)
            If Not PFound Is Nothing Then
                If Not DFound Is Nothing Then
                    If Not BFound Is Nothing Then
                        Application.GoTo BFound, True
                        Application.GoTo DFound, True
                        Application.GoTo PFound, True
                        If Range("A" & ActiveCell.Row).Value = PartNo Then 'And Range("B" & ActiveCell.Row).Value = Description And Range("C" & ActiveCell.Row).Value = Brand Then
                        Windows(CurrentBookName).Activate
                       
                        Stock = Range("d" & ActiveCell.Row).Value
                        Range("A" & ActiveCell.Row).Cells.Interior.Color = vbGreen
                        Windows(BookName).Activate
                        Range("d" & ActiveCell.Row).Value = Range("d" & ActiveCell.Row).Value + Stock
                        Windows(CurrentBookName).Activate
                        Range("A" & ActiveCell.Row + 1).Select
                        
                        Else
                        Windows(CurrentBookName).Activate
                        Range("A" & ActiveCell.Row + 1).Select
                        End If
                        Exit For
                      
                    End If
                End If
            End If
        End With
    Next ws
On Error GoTo 0

    Windows(CurrentBookName).Activate
    Range("A" & ActiveCell.Row + 1).Select


Next cnt
'For Each ws In Worksheets
'Cells.Find(PartNo, ActiveCell, xlFormulas, xlWhole, xlByRows, xlNext, False).Activate
'Next
End Sub