Data in 2 worksheets in same workbook

D

DThib

Active Member
Joined
Mar 19, 2010
Messages
464
Office Version
  1. 365
Platform
  1. Windows
Help, please!

My code is creating issues. The data with the new part in red is suppose to look for new IDs that match criteria and continue adding data from that code in worksheet ("MK_DB1") to the worksheet ("SPR").
It instead is adding iterations of the information and looping through all ids and adding data not unique.

What is going on? Anyone have an idea?



Code: 
Sub Workie1()


  Dim LastRow, SecondRow As Long
  Dim i As Long
  Dim j As Long, BatchP As Long
  Dim Sp As Variant, X As Variant
  Dim loop_ctr As Integer
  Dim rngCell, r1, r2 As Range


    With Worksheets("MK_DB1")
        LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
    End With
    With Worksheets("SPR")
        SecondRow = .Cells(Rows.Count, "A").End(xlUp).Row
    End With
    
        i = 1 + LastRow
        j = 1 + SecondRow
    For i = 1 To LastRow 'Each i In Worksheets("MK_DB1")
        If Worksheets("MK_DB1").Cells(i, 22) = "Knapczyk, Maciej" Then
           
[FONT=&quot][B][COLOR=#b22222]           With Worksheets("SPR")[/COLOR][/B][/FONT]
[FONT=&quot][B][COLOR=#b22222]               Set r1 = .Range("A1", .Range("A2").End(xlDown))[/COLOR][/B][/FONT]
[FONT=&quot][B][COLOR=#b22222]           End With[/COLOR][/B][/FONT]
[FONT=&quot][B][COLOR=#b22222]           With Worksheets("MK_DB1")[/COLOR][/B][/FONT]
[FONT=&quot][B][COLOR=#b22222]               Set r2 = .Range("B2", .Range("B2").End(xlDown))[/COLOR][/B][/FONT]
[FONT=&quot][B][COLOR=#b22222]           End With[/COLOR][/B][/FONT]

[FONT=&quot][B][COLOR=#b22222]            For Each rngCell In r1[/COLOR][/B][/FONT]
[FONT=&quot][B][COLOR=#b22222]              If WorksheetFunction.CountIf(r2, rngCell) = 0 Then[/COLOR][/B][/FONT]
[FONT=&quot][B][COLOR=#b22222]                   Worksheets("SPR").Cells(j, 1) = Worksheets("MK_DB1").Cells(i, 2).Value[/COLOR][/B][/FONT]
[FONT=&quot][B][COLOR=#b22222]              End If[/COLOR][/B][/FONT]
            If Worksheets("MK_DB1").Cells(i, 8).Value = "" Then
               Worksheets("SPR").Cells(j, 2) = Worksheets("MK_DB1").Cells(i, 9).Value
            Else
               Worksheets("SPR").Cells(j, 2) = Worksheets("MK_DB1").Cells(i, 8).Value 'AIC
            End If


           Worksheets("SPR").Cells(j, 3) = Worksheets("MK_DB1").Cells(i, 16).Value 'SW Ver
           Worksheets("SPR").Cells(j, 4) = Worksheets("MK_DB1").Cells(i, 24).Value 'Date Assigned
           If Worksheets("MK_DB1").Cells(i, 5) = 0 Then
              Worksheets("SPR").Cells(j, 8) = ""
           Else: Worksheets("SPR").Cells(j, 8) = Worksheets("MK_DB1").Cells(i, 5)
           End If 'SalesForce
           Worksheets("SPR").Cells(j, 5) = Worksheets("MK_DB1").Cells(i, 18).Value 'DateSPREntered


           If Worksheets("MK_DB1").Cells(i, 10) <> "" Then
            Sp = Split(Replace(Worksheets("MK_DB1").Cells(i, 10).Value, "(", ")"), ")")
            With Application
              X = .Index(Sp, .Match("10", Sp, 0) + 1)
            End With
            If Not IsError(X) Then Worksheets("SPR").Cells(j, 15).Value = X
           ElseIf Worksheets("MK_DB1").Cells(i, 11) <> "" Then
            Sp = Split(Replace(Worksheets("MK_DB1").Cells(i, 11).Value, "(", ")"), ")")
            With Application
              X = .Index(Sp, .Match("10", Sp, 0) + 1)
            End With
            If Not IsError(X) Then Worksheets("SPR").Cells(j, 15).Value = X
           End If
            'Batch # Left(Cells(I, 10), BatchP + 1)
             Worksheets("SPR").Cells(j, 21) = Worksheets("MK_DB1").Cells(i, 39).Value 'Date Occurred
             Worksheets("SPR").Cells(j, 25) = Worksheets("MK_DB1").Cells(i, 31).Value 'Symptom
             Worksheets("SPR").Cells(j, 30) = Worksheets("MK_DB1").Cells(i, 40).Value 'Submitted by Name
             Worksheets("SPR").Cells(j, 18) = Worksheets("MK_DB1").Cells(i, 48).Value 'Failed Component Serial Number
             Worksheets("SPR").Cells(j, 17) = Worksheets("MK_DB1").Cells(i, 49).Value 'Component Lot #
             Worksheets("SPR").Cells(j, 34) = Worksheets("MK_DB1").Cells(i, 23).Value 'Status
            j = j + 1
[FONT=&quot][B][COLOR=#b22222]         Next rngCell[/COLOR][/B][/FONT]
         End If
        Next i

End Sub

DThib
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Sort by date Sort by votes
Anyone have an answer? This compares to every cell (66) and then derives 66 answers for each comparison.
It should only give one.
If matches criteria, compare ID and place any new in table and continue code.

Someone here surely can help.

DThib
 
Upvote 0
OK. Partially fixed.

Now it goes through the list and adds new items but continues and starts adding the already present items it is supposed to ignore.
Anyone help? PLEASE!

Code: 
Sub Workie1()


  Dim LastRow, SecondRow As Long
  Dim i As Long
  Dim j As Long
  Dim Sp As Variant, X As Variant
  Dim fgf As Integer
  Dim rngCell As Range
  Dim r1, r2 As Range
  Dim MKTable As Range


      LastRow = Worksheets("DB1").Cells(Rows.Count, "B").End(xlUp).Row
      SecondRow = Worksheets("SPR").Cells(Rows.Count, "A").End(xlUp).Row
      
        i = 1 + LastRow
        j = 1 + SecondRow


       'For i = 1 To LastRow 'Each i In Worksheets("DB1")
          'If Worksheets("DB1").Cells(i, 23) = "Smith, Mac" Then


   For fgf = 0 To 1
       With Worksheets("SPR")
           Set r1 = .Range("Table1[SPR]").End(xlDown)
       End With
       With Worksheets("DB1")
           Set r2 = .Range("B2", .Range("B2").End(xlDown))
       End With
       For Each rngCell In r1
        If WorksheetFunction.CountIf(r2, rngCell) = 0 Then
           Sheets("SPR").Range("A" & Rows.Count).End(xlUp).Offset(1) = rngCell
         For i = 1 To LastRow 'Each i In Worksheets("DB1")
           If Worksheets("DB1").Cells(i, 22) = "Knapczyk, Maciej" Then
               Worksheets("SPR").Cells(j, 1) = Worksheets("DB1").Cells(i, 2)
               If Worksheets("DB1").Cells(i, 8).Value = "" Then
                   Worksheets("SPR").Cells(j, 2) = Worksheets("DB1").Cells(i, 9).Value
               Else
                   Worksheets("SPR").Cells(j, 2) = Worksheets("DB1").Cells(i, 8).Value 'AIC
               End If
                Worksheets("SPR").Cells(j, 3) = Worksheets("DB1").Cells(i, 16).Value 'SW Ver
                Worksheets("SPR").Cells(j, 4) = Worksheets("DB1").Cells(i, 24).Value 'Date Assigned
                If Worksheets("DB1").Cells(i, 5) = 0 Then
                   Worksheets("SPR").Cells(j, 8) = ""
                Else: Worksheets("SPR").Cells(j, 8) = Worksheets("DB1").Cells(i, 5)
                End If 'SalesForce
                Worksheets("SPR").Cells(j, 5) = Worksheets("DB1").Cells(i, 18).Value 'DateSPREntered
                If Worksheets("DB1").Cells(i, 10) <> "" Then
                  Sp = Split(Replace(Worksheets("DB1").Cells(i, 10).Value, "(", ")"), ")")
                With Application
                   X = .Index(Sp, .Match("10", Sp, 0) + 1)
                End With
                If Not IsError(X) Then Worksheets("SPR").Cells(j, 15).Value = X
                ElseIf Worksheets("DB1").Cells(i, 11) <> "" Then
                  Sp = Split(Replace(Worksheets("DB1").Cells(i, 11).Value, "(", ")"), ")")
                With Application
                  X = .Index(Sp, .Match("10", Sp, 0) + 1)
                End With
                If Not IsError(X) Then Worksheets("SPR").Cells(j, 15).Value = X
                End If
                 Worksheets("SPR").Cells(j, 21) = Worksheets("DB1").Cells(i, 39).Value 'Date Occurred
                 Worksheets("SPR").Cells(j, 25) = Worksheets("DB1").Cells(i, 31).Value 'Symptom
                 Worksheets("SPR").Cells(j, 30) = Worksheets("DB1").Cells(i, 40).Value 'Submitted by Name
                 Worksheets("SPR").Cells(j, 18) = Worksheets("DB1").Cells(i, 48).Value 'Failed Component Serial Number
                 Worksheets("SPR").Cells(j, 17) = Worksheets("DB1").Cells(i, 49).Value 'Component Lot #
                 Worksheets("SPR").Cells(j, 34) = Worksheets("DB1").Cells(i, 23).Value 'Status
                 j = j + 1
           End If
         Next
         End If
        Next
     Next
End Sub
 
Upvote 0
Figured it out.
If anyone needs help with this, I will help you.


DThib
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Run-time error '380' Could not set the Value property. Invalid property value
Replies
7
Views
844
aabrazil1
A
A
  • Solved
Could not set the RowSource property. Invalid property value. Error 380
2
Replies
16
Views
210
RoryA
RoryA
A
  • Question Question
Autofilter code based on username
Replies
1
Views
368
aabrazil1
A
S
  • Solved
Copy Textbox values from UserForm to the worksheet
Replies
6
Views
298
AlphaFrog
AlphaFrog
D
  • Question Question
Print Multiple invoices in one PDF File
Replies
1
Views
305
John_w
J

Forum statistics

Threads
1,223,903
Messages
6,175,289
Members
452,631
Latest member
a_potato

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