PDA

View Full Version : [SOLVED] Macro that to transfer information sheets by product



k0st4din
12-05-2014, 02:40 PM
Hello everyone,
asking for your help to make a macro that I can not handle.
First published and made an inquiry on this site (http://www.mrexcel.com/forum/excel-questions/822122-macro-save-information-accumulated-product-but-different-weights-available.html), but no response yet.
please you for your assistance to make a macro that automates the actions that I do manually.
Each month, receive information about products sold, which copy and put in a master file. I have over 80 separate sheets with the names of each product. Once the information transmitted for example January, I save the file and wait for the information to come next month. Then filter the new month and start again manually choose products (!!! very important - have the same products but with different weight in grams) and put the information in the last line of the previous month, ie should be cumulative. Attach sample file and give a link if you want to watch and video.
Thank you in advance for your cooperation on your part.
Link to file (https://www.sendspace.com/file/fi3b4j)
Link to video (https://drive.google.com/file/d/0BzbSYUMuiNUEdTZneGdscDhQV2s/view?usp=sharing)

mancubus
12-06-2014, 05:19 PM
k0st4din!

you are not a VBAX newbie and you know you can post your workbook here.

that said, i assume:
the leftmost worksheet contains consolidated data of products sold.
each month you want to split previous month's data. (so whey you run below code now, it will split 2014-November's sales data.)



Sub Split_Monthly_Sales_To_Product_Worksheets()


Dim ProductNames As String
Dim Products
Dim i As Integer

With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With


For i = 2 To Worksheets.Count
ProductNames = ProductNames & "|" & Worksheets(i).Name
Next


Products = Split(Mid(ProductNames, 2), "|")

With Worksheets(1)
.AutoFilterMode = False
.Cells(1).AutoFilter Field:=1, Criteria1:=xlFilterLastMonth, Operator:=xlFilterDynamic
For i = LBound(Products) To UBound(Products)
.Cells(1).AutoFilter Field:=3, Criteria1:="=*" & Products(i) & "*"
With .AutoFilter.Range
If .Rows.Count > 1 Then
.Offset(1).Copy Worksheets(Products(i)).Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
End With
Next i
.AutoFilterMode = False
End With


End Sub

mancubus
12-06-2014, 05:24 PM
.Cells(1).AutoFilter Field:=1, Criteria1:=xlFilterLastMonth, Operator:=xlFilterDynamic

this is a special date filter for previous month.
if you want to filter data for a month of choice, you should modify this line.

k0st4din
12-07-2014, 12:00 AM
Hello mancubus,
many thanks for the support of your country for this macro, but I have some questions:
1. How exactly chose to be this November, as the table I set the example in January and December. (but otherwise is very cleverly done from your side, thus no loads system) :)
2. This question is perhaps linked with the first - ie I made a button and there is macro(Module4), but pushed it nothing happens, ie there is no transfer of information (product sheets on them)?
3. This additional line that I (if I want and I can change) - less is not my clear - ie could you handing me some example of what will be changed in line to become the January month (for example)
Thank you infinitely many

mancubus
12-07-2014, 04:08 PM
welcome.

1) you may ask for a date entry. in this case you have to change the first autofilter.
2) because Column A does not contain dates in November 2014.
3) like so:



Sub Split_Monthly_Sales_To_Product_Worksheets()


Dim ProductNames As String
Dim Products
Dim i As Integer
Dim LastDateInMonth As String


With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With


For i = 2 To Worksheets.Count
ProductNames = ProductNames & "|" & Worksheets(i).Name
Next


Products = Split(Mid(ProductNames, 2), "|")

LastDateInMonth = Application.InputBox("Enter Last Date of Month in 'MM/DD/YYYY' format Like 11/30/2014")

With Worksheets(1)
.AutoFilterMode = False
.Cells(1).AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(1, LastDateInMonth)
For i = LBound(Products) To UBound(Products)
.Cells(1).AutoFilter Field:=3, Criteria1:="=*" & Products(i) & "*"
With .AutoFilter.Range
If .Rows.Count > 1 Then
.Offset(1).Copy Worksheets(Products(i)).Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
End With
Next i
.AutoFilterMode = False
End With

End Sub

k0st4din
12-10-2014, 12:43 PM
Hello mancubus,
and this macro is superb.
Thank you for your endless support.

Otherwise both macro is super, super, super...............

Thank you

mancubus
12-10-2014, 02:01 PM
you are welcome.

pls mark the thread as "solved" from thread tools dropdown which is above the first message.

k0st4din
12-28-2014, 01:33 PM
Hello mancubus (http://www.vbaexpress.com/forum/member.php?37987-mancubus),
both macros do a perfect job - for which I thank you very much.
I would like to ask you (in view of the fact that there have been some changes) if he could tell me how to do so sheet that collect sales each month - in the macro I give him a name?
Ie in your macro you tell me the following: If the database is the left sheet (first at left)
your words - "the leftmost worksheet contains consolidated data of products sold."
My idea is that nothing changes in the macro because it works flawlessly, but sometime in the early to add something, I ask him the name of the sheet from which to carry information on all other sheets. In this way I will be able to put in the same workbook same macro (but with a different name) and there only to change the name of the sheet and again I carry all the information sheets.
Is it possible to rework a little early this wonderful macro?
Thank you in advance and happy holidays.

Sub Split_Monthly_Sales_To_Product_Worksheets_name_of_sheet_Product() 'the first
'Is it possible to revise and add me to write from which sheet to carry information on all other sheets

Dim ProductNames As String
Dim Products
Dim i As Integer
Dim LastDateInMonth As String


With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With


For i = 2 To Worksheets.Count
ProductNames = ProductNames & "|" & Worksheets(i).Name
Next


Products = Split(Mid(ProductNames, 2), "|")

LastDateInMonth = Application.InputBox("Enter Last Date of Month in 'MM/DD/YYYY' format Like 11/30/2014")

With Worksheets(1)
.AutoFilterMode = False
.Cells(1).AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(1, LastDateInMonth)
For i = LBound(Products) To UBound(Products)
.Cells(1).AutoFilter Field:=3, Criteria1:="=*" & Products(i) & "*"
With .AutoFilter.Range
If .Rows.Count > 1 Then
.Offset(1).Copy Worksheets(Products(i)).Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
End With
Next i
.AutoFilterMode = False
End With

End Sub

and other macro that will be for another worksheet


Sub Split_Monthly_Sales_To_Product_Worksheets_name_of_sheet_Product_another_wor ksheet() 'the second
'Is it possible to revise and add me to write from which sheet to carry information on all other sheets

Dim ProductNames As String
Dim Products
Dim i As Integer
Dim LastDateInMonth As String


With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With


For i = 2 To Worksheets.Count
ProductNames = ProductNames & "|" & Worksheets(i).Name
Next


Products = Split(Mid(ProductNames, 2), "|")

LastDateInMonth = Application.InputBox("Enter Last Date of Month in 'MM/DD/YYYY' format Like 11/30/2014")

With Worksheets(1)
.AutoFilterMode = False
.Cells(1).AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(1, LastDateInMonth)
For i = LBound(Products) To UBound(Products)
.Cells(1).AutoFilter Field:=3, Criteria1:="=*" & Products(i) & "*"
With .AutoFilter.Range
If .Rows.Count > 1 Then
.Offset(1).Copy Worksheets(Products(i)).Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
End With
Next i
.AutoFilterMode = False
End With

End Sub
I just have to have two worksheets from which to carry on the same location information

mancubus
12-29-2014, 02:51 AM
so you have 2 worksheets which contain sales data and you want to choose between them.

one way to do this is to make the user input the worksheet name.

chance SalesData1 and SalesData2 in below code to actual worksheet names in your worbook.



Sub Split_Monthly_Sales_2ws_To_Product_Worksheets()

Dim ProductNames As String, wsSales As String, LastDateInMonth As String
Dim Products
Dim i As Integer

With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With

For i = 1 To Worksheets.Count
If Worksheets(i).Name <> "SalesData1" And Worksheets(i).Name <> "SalesData2" Then
ProductNames = ProductNames & "|" & Worksheets(i).Name
End If
Next

Products = Split(Mid(ProductNames, 2), "|")
wsSales = Application.InputBox(Prompt:="Input the name of the worksheet which contains the sales data!", Type:=2)
LastDateInMonth = Application.InputBox(Prompt:="Enter Last Date of Month in 'MM/DD/YYYY' format Like 11/30/2014", Type:=2)

With Worksheets(wsSales)
.AutoFilterMode = False
.Cells(1).AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(1, LastDateInMonth)
For i = LBound(Products) To UBound(Products)
.Cells(1).AutoFilter Field:=3, Criteria1:="=*" & Products(i) & "*"
With .AutoFilter.Range
If .Rows.Count > 1 Then
.Offset(1).Copy Worksheets(Products(i)).Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
End With
Next i
.AutoFilterMode = False
End With

End Sub

k0st4din
12-29-2014, 03:54 PM
Hello mancubus (http://www.vbaexpress.com/forum/member.php?37987-mancubus),
Super macro is invented by you, carried by two worksheets information exactly where it should be.
Thank you from my heart for your help. :clap::friends:

mancubus
12-30-2014, 03:04 AM
you are welcome.
thanks but i did not invent it. :)
i just organized some coding to meet your requirements.

k0st4din
11-29-2019, 09:53 AM
Hello mancubus,
it's been so many years and this macro that helped me and to this day it does a great job for me.
I just have no words to thank you for.
I have a request if the same macro can change slightly after the moment of copying the information.


In principle, the distribution is the same as the way the macro works, but whether it can be made through certain columns to skip 2 empty columns and retrieve the same information (as it is).
Immediately I give an example:
Using the macro, in the first window that pops up, I am asked from which worksheet to copy the information and spread it on the other worksheets. Immediately after the first window pops up, a second window appears to write for which date. And the copying begins.
Everything is super, super, super - wonderful. :)
I currently have information from A to F - and everything is copied exactly where it should be.
Now with this macro, though, I'm trying to help myself to another table, but a little different.
I have to transfer information from A to F again, but:
The information in columns A and B of the selected worksheet (GL) and the date selected respectively - is allocated to the others on the other worksheets again in columns A and B.
The information from C and D and E is in columns E, F and G respectively
And the information from F be in J
Other worksheets in columns C, D, H and I have other information.
You may be confused, for this reason I attach an example table and if you have any questions, please ask me.
Thank you very much.

mancubus
12-04-2019, 05:08 AM
you should have opened a new thread, with a reference to this thread, instead.

btw, it seems columns have changed and you want a non-contiguous paste.

try below code:



Sub vbax_51313_2014_req2019_Split_Monthly_Sales_2ws_To_Product_Worksheets()


Dim ProductNames As String, wsSales As String, LastDateInMonth As String
Dim Products, slsArr
Dim i As Long, LastRow As Long


With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With


For i = 1 To Worksheets.Count
If Worksheets(i).Name <> "SalesData1" And Worksheets(i).Name <> "SalesData2" Then
ProductNames = ProductNames & "|" & Worksheets(i).Name
End If
Next

Products = Split(Mid(ProductNames, 2), "|")
wsSales = Application.InputBox(Prompt:="Input the name of the worksheet which contains the sales data!", Type:=2)
LastDateInMonth = Application.InputBox(Prompt:="Enter Last Date of Month in 'MM/DD/YYYY' format Like 11/30/2014", Type:=2)

With Worksheets(wsSales)
.AutoFilterMode = False
.Cells(1).AutoFilter Field:=6, Operator:=xlFilterValues, Criteria2:=Array(1, LastDateInMonth)
For i = LBound(Products) To UBound(Products)
.Cells(1).AutoFilter Field:=1, Criteria1:="=*" & Products(i) & "*"
If .AutoFilter.Range.Rows.Count > 1 Then
.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Copy .Cells(1, 100)
slsArr = .Cells(1, 100).CurrentRegion.Value
.Cells(1, 100).CurrentRegion.Clear
LastRow = Worksheets(Products(i)).Range("A" & Rows.Count).End(xlUp).Offset(1).Row
Worksheets(Products(i)).Cells(LastRow, 1).Resize(UBound(slsArr, 1), 1).Value = Application.Index(slsArr, , 1)
Worksheets(Products(i)).Cells(LastRow, 2).Resize(UBound(slsArr, 1), 1).Value = Application.Index(slsArr, , 2)
Worksheets(Products(i)).Cells(LastRow, 5).Resize(UBound(slsArr, 1), 1).Value = Application.Index(slsArr, , 3)
Worksheets(Products(i)).Cells(LastRow, 6).Resize(UBound(slsArr, 1), 1).Value = Application.Index(slsArr, , 4)
Worksheets(Products(i)).Cells(LastRow, 7).Resize(UBound(slsArr, 1), 1).Value = Application.Index(slsArr, , 5)
Worksheets(Products(i)).Cells(LastRow, 10).Resize(UBound(slsArr, 1), 1).Value = Application.Index(slsArr, , 6)
End If
Next i
.AutoFilterMode = False
End With

End Sub