Index Match VBA Solution

[sidey1978]

Hi all

I have been through various threads on this topic, but so far haven't been able to get to a solution that accomplishes what I need. Any help would be greatly appreciated!

I have a workbook, OrderForm, with two worksheets - Order1 & OrderHistory.

Order form is structured like this:

This sheet is overwritten daily by new data that is downloaded from an external source. My goal is to record the daily order quantity and the order date on the OrderHistory sheet to maintain the historic order data. Currently this is a manual process.

At the moment I have come up with the following VBA code:

Sub CopyPaste()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet

Set copySheet = Worksheets("Order1")
Set pasteSheet = Worksheets("OrderHistory")

copySheet.Range("L2").Copy
pasteSheet.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteValues

copySheet.Range("H7:H50").Copy
pasteSheet.Cells(1, Columns.Count).End(xlToLeft).Offset(1, 0).PasteSpecial xlPasteValues

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

However the data from the external source will not always have all the product lines is that line is stopped, so the code above won't work for what I need.

I have tried to use INDEX MATCH but haven't been successful.

What I need is:
To copy the order quantity (column H) for the product lines in the next available column in the OrderHistory workbook. So today it copies into column C, tomorrow D, the next day column E etc etc. It also needs to copy over the order date as the column header into column C row 1, column D row 1 etc etc.

Is that achievable?

Thanks for any help that is out there!
Cheers

 

[BSALV]

Sub CopyPaste()
     Dim MyA, MyC, C
     Application.ScreenUpdating = False
     Dim copySheet As Worksheet
     Dim pasteSheet As Worksheet

     Set copySheet = Worksheets("Order1")
     Set pasteSheet = Worksheets("OrderHistory")

     'find matches between column A of copysheet and column C of pastesheet !!!!!!!!!!!!!!!!
     Set MyC = pasteSheet.Columns(3)                            'range of the 3rd column of your paste sheet
     Set MyA = copySheet.Range("A1").CurrentRegion.Resize(, 1)  'range of the 1st column of copy sheet

     Set C = pasteSheet.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)     '1st cell of your new column in paste
     C.Value = copySheet.Range("D2").Value                      'is it L2 or D2 ????

     For i = 2 To MyA.Rows.Count                                '1st row is header, so loop from row 2 until end
          r = Application.Match(MyA.Cells(i, 1).Value, MyC, 0)  'find matching codes (otherwise the same can be done for the description)

     '************************************************************
     'this 5 lines are temporary, delete later
          If IsNumeric(r) Then
               MsgBox MyA.Cells(i, 1).Value & " is in row " & r
          Else
               MsgBox MyA.Cells(i, 1).Value & " isn't found"
          End If
     '*************************************************************
          If IsNumeric(r) Then
               C.Offset(r - 1).Value = MyA.Cells(i, 4).Value    'write in the new column of paste the value found in the 4th column of copy
          Else
               MsgBox MyA.Cells(i, 1).Value & " isn't found", vbCritical
          End If
     Next

     Application.CutCopyMode = False
     Application.ScreenUpdating = True
End Sub

 

[sidey1978]

Thank you so much @BSALV!

I made a slight amend to reference the columns I needed, but this has worked a treat and made my life a lot easier!

Here's the code I have saved:

Sub CopyPaste()
     Dim MyA, MyC, C
     Application.ScreenUpdating = False
     Dim copySheet As Worksheet
     Dim pasteSheet As Worksheet

     Set copySheet = Worksheets("Order1")
     Set pasteSheet = Worksheets("OrderHistory")

     'find matches between column A of copysheet and column C of pastesheet !!!!!!!!!!!!!!!!
     Set MyC = pasteSheet.Columns(1)                            'range of the 1st column of your paste sheet
     Set MyA = copySheet.Range("A1").CurrentRegion.Resize(, 1)  'range of the 1st column of copy sheet

     Set C = pasteSheet.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)     '1st cell of your new column in paste
     C.Value = copySheet.Range("L2").Value

     For i = 2 To MyA.Rows.Count                                '1st row is header, so loop from row 2 until end
          r = Application.Match(MyA.Cells(i, 3).Value, MyC, 0)  'find matching codes (otherwise the same can be done for the description)

          If IsNumeric(r) Then
               C.Offset(r - 1).Value = MyA.Cells(i, 8).Value    'write in the new column of paste the value found in the 8th column of copy
          Else
               MsgBox MyA.Cells(i, 1).Value & " isn't found", vbCritical
          End If
     Next

     Application.CutCopyMode = False
     Application.ScreenUpdating = True
End Sub

Quick question though. Can the code work without the MsgBox function, or is that mandatory?

Thanks!

 

[BSALV]

what do you want ?
No msgbox at all or at the end 1 msgbox with all the failed numbers ?

for the 2nd option, s is a string which collects all missing codes and at the end you get 1 msgbox in case of missing.
if you want no msgbox at all, you can delete the msgbox in previous post

          If IsNumeric(r) Then
               C.Offset(r - 1).Value = MyA.Cells(i, 8).Value    'write in the new column of paste the value found in the 8th column of copy
          Else
               s = s & vbLf & MyA.Cells(i, 1).Value             'string with all the missed codes and a linefeed as separator
          End If
     Next

     If Len(s) > 0 Then MsgBox s, vbInformation, UCase("all missing codes")

 

[sidey1978]

@BSALV that's great thank you. I was trying to get no message box at all, but one with all the missing codes is very helpful actually. Thanks for all your help, it is much appreciated!

 

[BSALV]

you're welcome