Automatically mapping and collating data into a new workbook using Excel VBA

[Wedds]

Hi everyone,

Its been a while since I've used vba. I've written this code where the user clicks a button on a worksheet and the data in various rows are cut and pasted onto a different tab, as seen below. I have also enclosed an example of the worksheet for you to see an example. Is it possible to do the same operation with different data sets from different tabs to be copied into a new blank workbook on one tab? Is it possible for the code to be flexible depending on the user's data input and column headers to change the data - and click the button and data to be parsed onto the same workbook on the same worksheet? All the data has to be collated on the same worksheet as report to be then connected to an Oracle database. Can you amend my code to do this? You can play around with my worksheet to help me with a suggestion on how to do this? Also, you can send me resources or ideas that may support and my learning on how to do this? Maybe you have worked on a similar project and may have some dynamic ideas or code that processed without any errors. Please feel free to share, as I am relatively basic vba coder. (I have also copied the code below. Please feel free to amend the code to adjust to my requirements)

Thanks for your support.


Regards,

Andy

Option Explicit
 
Sub InventoryUpdate()
 
Dim ItemID As Long
Dim ProductName As String
Dim Delivery As Integer
Dim keepsearching As Boolean
Dim rownum As Long
 
ItemID = Range("A2").Value
ProductName = Range("b2").Value
Delivery = Range("C2").Value
keepsearching = True
rownum = 3
 
Worksheets("Inventory").Activate
 
Do Until keepsearching = False
 
        If Cells(rownum, 1).Value = ItemID Then
        Cells(rownum, 3).Value = Cells(rownum, 3).Value + Delivery
        Cells(rownum, 4).Value = Date
        
        keepsearching = False
       
        ElseIf Cells(rownum, 1).Value = "" Then
       
        Cells(rownum, 1).Value = ItemID
        Cells(rownum, 2).Value = ProductName
        Cells(rownum, 3).Value = Delivery
        Cells(rownum, 4).Value = Date
       
       
        Else
       
        rownum = rownum + 1
            
       End If
 
Loop
 
Worksheets("Update").Activate
Range("A2").Select
Range("A2:C2").ClearContents
 
 
MsgBox "The inventory sheet has been updated"
 
End Sub

[mdmackillop]

Please don't be so mean with your sample. There is no data on the Update sheet on which to test, no alternative layouts or required outputs. You are asking for a lot of solutions. Deal with them one at a time. What is the first issue?

[Wedds]

Hi mdmackillop,

Sorry for not attaching the spreadsheet with data. My first issue is that I would like button 2 on the update tab, to copy over the data from columns A, B and C and the data from columns A, B,C on the Update 2 tab copied to the inventory tab in columns A,B and updating column C,and then pasting any duplicated fields to the duplicates tab. I have reattached the spreadsheet with data. I hope this is a lot helpful and clear.


Thanks,
Andy

[mdmackillop]

Option Explicit


Sub Test()
    Dim InvID As Range, DelID As Range
    Dim wsINV As Worksheet, wsDEL As Worksheet
    Dim cel As Range, c As Range
    Set wsINV = Sheets("Inventory")
    Set wsDEL = Sheets("Update")
    Set InvID = wsINV.Range("A2:A500").SpecialCells(2)
    Set DelID = wsDEL.Range("A2:A500").SpecialCells(2)
    For Each cel In InvID
        Set c = DelID.Find(cel)
        If Not c Is Nothing Then
            cel.Offset(, 2) = cel.Offset(, 2) + c.Offset(, 2)
            cel.Offset(, 3) = Date
            c.Resize(, 3).ClearContents
        End If
    Next cel
    Set DelID = wsDEL.Range("A2:A500").SpecialCells(2)
    DelID.Offset(, 3) = Date
    DelID.Resize(, 4).Cut wsINV.Cells(Rows.Count, 1).End(xlUp)(2)
End Sub

I'm not clear from your sample where the duplicates arise.

[Wedds]

Option Explicit


Sub Test()
    Dim InvID As Range, DelID As Range
    Dim wsINV As Worksheet, wsDEL As Worksheet
    Dim cel As Range, c As Range
    Set wsINV = Sheets("Inventory")
    Set wsDEL = Sheets("Update")
    Set InvID = wsINV.Range("A2:A500").SpecialCells(2)
    Set DelID = wsDEL.Range("A2:A500").SpecialCells(2)
    For Each cel In InvID
        Set c = DelID.Find(cel)
        If Not c Is Nothing Then
            cel.Offset(, 2) = cel.Offset(, 2) + c.Offset(, 2)
            cel.Offset(, 3) = Date
            c.Resize(, 3).ClearContents
        End If
    Next cel
    Set DelID = wsDEL.Range("A2:A500").SpecialCells(2)
    DelID.Offset(, 3) = Date
    DelID.Resize(, 4).Cut wsINV.Cells(Rows.Count, 1).End(xlUp)(2)
End Sub

I'm not clear from your sample where the duplicates arise.

Thank you for the education! The data on the duplicates tab displays an historical record of all the inventories that were added to the stock level with the same ID, on a particular date on the inventory tab. Here is the code for that action:
Please feel free to refine it.

Option Explicit

Sub FindCopy()
    Dim lw As Long
    Dim i As Integer
    Dim sh As Worksheet
     
    Set sh = Sheets("Duplicates")
    lw = Range("A" & Rows.Count).End(xlUp).Row
     
    For i = 1 To lw 'Find duplicates from the list.
        If Application.CountIf(Range("A" & i & ":A" & lw), Range("A" & i).Text) > 1 Then
            Range("B" & i).Value = Date
        End If
    Next i
     
    Range("A2:C2").AutoFilter , Field:=2, Criteria1:=1
    Range("A2", Range("A65536").End(xlUp)).EntireRow.Copy
    sh.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Selection.AutoFilter
End Sub