PDA

View Full Version : Automatically mapping and collating data into a new workbook using Excel VBA



Wedds
07-06-2016, 12:24 AM
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
07-06-2016, 11:33 AM
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
07-06-2016, 01:32 PM
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
07-06-2016, 03:04 PM
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
07-06-2016, 11:50 PM
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