Array

[jkelly228]

Hello All,

I have posted in the excelforum.com website on this thread, but I haven't really received a response.

I have a list of 200 Parts and their associated Order Types on one sheet and the same type of list on a 2nd sheet. Column A has the list of Parts and Column B has the list of Order Types.

I think I need an array that can combine Sheet 1 column A and B together and compare it to Sheet 2 Column A and B. When a match is found then it needs to take the values in sheet 2 and paste them in the correct cell on sheet 1.

If you follow the link the attached spreadsheet should help explain what I am looking for. I have been working on this since Thursday and I really need to get this resolved so I can move on with other tasks. Below is the code that I have so far.

I appreciate any help you can provide.

Sub Date_Range()
    Dim MyArr3 As Variant
    Dim MyArr1 As Variant
 
    Sheet3.Select
    Dim ItemLookup3        As Long
    ItemLookup = Cells.Find(What:="*", _
    SearchDirection:=xlPrevious, _
    SearchOrder:=xlByRows).Row
 
    Sheet1.Select
    Dim ItemLookup1        As Long
    ItemLookup = Cells.Find(What:="*", _
    SearchDirection:=xlPrevious, _
    SearchOrder:=xlByRows).Row
 
    With Sheets(3): Set MyArr3 = .Range(.[a2], .Cells(Rows.Count, "a").End(xlUp)): End With
    With Sheets(1): Set MyArr1 = .Range(.[a2], .Cells(Rows.Count, "a").End(xlUp)): End With: i = 1
 
    Sheet3.Select
    Dim LoopColumn As Long
    Dim LoopColumn2 As Long
    For LoopColumn = 2000 To 2 Step -1
        If Cells(MyArr3, 1) = Cells(MyArr1, 1) Then
            Range(Cells(LoopColumn, 3), Cells(LoopColumn, 11)).Copy
            Sheet1.Select
            Call Find_Part2
        End If
    Next LoopColumn
End Sub
Sub Find_Part2()
    Dim ItemLookup1        As Long
    ItemLookup = Cells.Find(What:="*", _
    SearchDirection:=xlPrevious, _
    SearchOrder:=xlByRows).Row
    Dim LoopColumn2 As Long
    For LoopColumn2 = 2000 To 2 Step -1
        If Cells(LoopColumn2, 1) = "MyArr3" And Cells(LoopColumn2, 2) = "MyArr1" Then
            Cells(LoopColumn2, 4).Select '.PasteSpecial Paste:=xlPasteValues
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If
    Next LoopColumn2
End Sub

Kelly

 

[jkelly228]

I have made some progress on my code, but I think I have the wrong Variable type. Below is the code that I have, and the error "Type Mismatch" occurs at this line "If MyArr3 = MyArr1 Then".

Any help would be greatly appreciated.

Sub Date_Range()
    Dim MyArr3 As Variant
    Dim MyArr1 As Variant
 
    Sheet3.Select
    Dim ItemLookup3        As Long
    ItemLookup = Cells.Find(What:="*", _
    SearchDirection:=xlPrevious, _
    SearchOrder:=xlByRows).Row
 
    Sheet1.Select
    Dim ItemLookup1        As Long
    ItemLookup = Cells.Find(What:="*", _
    SearchDirection:=xlPrevious, _
    SearchOrder:=xlByRows).Row
 
    With Sheets(3): Set MyArr3 = .Range(.[a2], .Cells(Rows.Count, "b").End(xlUp)): End With
    With Sheets(1): Set MyArr1 = .Range(.[a2], .Cells(Rows.Count, "b").End(xlUp)): End With: i = 1
 
    Sheet3.Select
    Dim LoopColumn As Variant
    Dim LoopColumn2 As Variant
    For LoopColumn = 2000 To 2 Step -1
        If MyArr3 = MyArr1 Then
            Range(Cells(LoopColumn, 3), Cells(LoopColumn, 11)).Copy
            Sheet1.Select
            Call Find_Part2
        End If
    Next LoopColumn
End Sub
Sub Find_Part2()
    Dim ItemLookup1        As Long
    ItemLookup = Cells.Find(What:="*", _
    SearchDirection:=xlPrevious, _
    SearchOrder:=xlByRows).Row
    Dim LoopColumn2 As Long
    For LoopColumn2 = 2000 To 2 Step -1
        If Cells(LoopColumn2, 1) = "MyArr3" And Cells(LoopColumn2, 2) = "MyArr1" Then
            Cells(LoopColumn2, 4).Select '.PasteSpecial Paste:=xlPasteValues
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If
    Next LoopColumn2
End Sub

 

[RSXchin]

This is a work around

Sub array_stuffs()
Dim myarg1 As Variant
Dim myarg2 As Variant

myarg1 = Array(1, 3)
myarg2 = Array(1, 2)
If UBound(myarg1) = UBound(myarg2) Then
    For i = 0 To UBound(myarg1)
        If myarg1(i) <> myarg2(i) Then
            MsgBox ("arrays are different")
        End If
    Next i
    MsgBox "arrays are the same"
    End If
End Sub

 

[jkelly228]

Hi rsxchin,

Thanks for the help. I did manage to run the macro you typed and it tells me that there is a match, but not entirely sure how to modify it to now get it to copy and paste the data from one row to another based on this.

Below is the code as I have it so far. I figured out the variable aspect, but now even though I know there are rows that match, it never executes the copy and paste portion of the code.

Is it that it sees the 2 different data points as separate objects and so it will never run the copy and paste function because it isn't a string? Really stuck on this.

As always, any help is appreciated. Thanks

Sub Date_Range()
    Dim MyArr3 As Range
    Dim MyArr1 As Range
 
    Sheet3.Select
    Dim ItemLookup3        As Long
    ItemLookup = Cells.Find(What:="*", _
    SearchDirection:=xlPrevious, _
    SearchOrder:=xlByRows).Row
 
    Sheet1.Select
    Dim ItemLookup1        As Long
    ItemLookup = Cells.Find(What:="*", _
    SearchDirection:=xlPrevious, _
    SearchOrder:=xlByRows).Row
 
 
    With Sheets(3): Set MyArr3 = .Range(.[a2], .Cells(Rows.Count, "b").End(xlUp)): End With
    With Sheets(1): Set MyArr1 = .Range(.[a2], .Cells(Rows.Count, "b").End(xlUp)): End With: i = 1
 
    Sheet3.Select
    Dim LoopColumn As Variant
    Dim LoopColumn2 As Variant
    For LoopColumn = 2000 To 2 Step -1
        If "MyArr3" = "MyArr1" Then
            Range(Cells(LoopColumn, 3), Cells(LoopColumn, 11)).Copy
            Sheet1.Select
            Range("MyArr1", 4).Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Call Find_Part2
        End If
    Next LoopColumn
End Sub

 

[jkelly228]

@rsxchin,

I did get your code to work somewhat. However, it doesn't really seem to read in Column A and B of spreadsheet 1 and 3. Maybe you can take a look at what I did wrong. Thanks

Sub Date_Range()
 
    MyArr1 = Array(1, 2)
    MyArr3 = Array(1, 2)
 
    Sheet3.Select
    Dim LoopColumn As Variant
    Dim LoopColumn2 As Variant
    If UBound(MyArr3) = UBound(MyArr1) Then
      Do
        For LoopColumn = 2000 To 2 Step -1
            If "MyArr3" <> "MyArr1" Then
                On Error Resume Next
            End If
            Next LoopColumn
            Range(Cells(LoopColumn, 3), Cells(LoopColumn, 11)).Copy
            Selection.Font.ColorIndex = 3
                Sheet1.Select
                Range("MyArr1", 4).Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                'Call Find_Part2
            Loop While MyArr3 Is Nothing And MyArr1 <> MyArr3
    End If
End Sub

 

[RSXchin]

I'm not entirely sure what you're trying to do. Why do you want to make sure the arrays are different?

 

[jkelly228]

I actually want to find where the data is the same and copy the information from Spreadsheet 3 to Spreadsheet 1.

 

[jkelly228]

Here is the code that I have so far. I think it is cleaner, but still can't get it to actually compare the values.

Sub Date_Range()
    Dim MyArr3 As Range
    Dim MyArr1 As Range
    Dim Item3 As Variant
    Dim Type3 As Variant
    Dim Item1 As Variant
    Dim Type1 As Variant
    Dim ResultArray As Variant
 
    With Sheets(3): Set Item3 = .Range(.["A2"], .Cells(Rows.Count, "A").End(xlUp)): End With
    With Sheets(3): Set Type3 = .Range(.["B2"], .Cells(Rows.Count, "B").End(xlUp)): End With
    With Sheets(1): Set Item1 = .Range(.["A2"], .Cells(Rows.Count, "A").End(xlUp)): End With
    With Sheets(1): Set Type1 = .Range(.["B2"], .Cells(Rows.Count, "B").End(xlUp)): End With: i = 1
 
    Sheet3.Select
    Dim LoopColumn As Variant
    For LoopColumn = 5000 To 2 Step -1
        If Item3.Offset(, 1) = Item1.Offset(, 1) And Type3.Offset(, 1) = Type1.Offset(, 1) Then
            Sheet1.Select
            Range("MyArr1", 4).Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Call Find_Part2
        End If
    Next LoopColumn
End Sub