I need a code to copy specific data from daily-updated excel workbook to my main excel workbook - vba

I have a main excel workbook (1) with many tables but contains same columns as;
productnumber________name_______surname_______price
xxx
Have another workbook (2) which contains columns as;
productnumber________city_______company_______price
What I have tried?
I have 10000 products in workbook 1, 500 products in workbook 2, so if i use VLOOKUP function on (xxx) cell by looking up the "productnumber" in other sheet, I get "Na" error in some of the cells due to a lack of enough productnumber in daily updated workbook (2)
Second workbook (2) is being updated everyday and I just want to copy and paste the daily prices to my main workbook (1) and
what is the shortest way to do it? How can I use VBA to do that? Which code would help me?
Thank you

Short of having enough information about the names of your objects, try adapting this working code to your names:
Sub refreshPrices()
Dim cel As Range, wbNewPrices As Workbook, v
Set wbNewPrices = Workbooks.Open("C:\SO\newPrices.xlsm")
For Each cel In ThisWorkbook.Sheets(1).Range("Table1[productnumber]")
v = Application.VLookup(cel.value, wbNewPrices.Sheets(1).Range("Table1"), 4, 0)
If Not IsError(v) Then cel.Offset(, 3).value = v
Next
wbNewPrices.Close False
End Sub

Related

Copying one sheet to another workbook based on one criteria

I have 2 different workbooks, main and copy.
Row 1 is meant for header/labeling the information it will be providing for both workbooks.
The "main" workbook will be using columns A to N. The copy will be using columns A to M.
The criteria to determine whether the code will be copying is the workbook, "main", column M.
If the cell contains "X" - it will copy column A to L, and N, to the workbook "copy". After which, it will go on to the next row to determine the same thing.
If the cell is empty, it will proceed down to the next row to determine the same thing as well.
The code has to be dynamic as new information will be added every 3 months, such as new rows added or the criteria changing from "X" to empty, or empty to "X".
I am a beginner in VBA excel, and have been trying out multiple codes but it doesn't seems to work. Would greatly appreciate it if someone could help me out with this.
Showing your code so far will help us a lot.
Maybe this helps a little:
Dim wks As Worksheet
Dim wks_copy As Worksheet
Set wks = Worksheets("main")
Set wks_copy = Worksheets("copy")
j = 2
For i = 2 To wks.UsedRange.Rows.Count
If wks.Cells(i, 13).Value = "x" Then
wks.Range(Cells(i, 1), Cells(i, 14)).Copy Destination:=wks_copy.Cells(j, 1)
j = j + 1
End If
Next i
This will copy the entire row. If you don't want to copy column M, I suggest clearing or hiding the column after copying.
If the macro runs again after 3 months, it will overwrite the existing data on Worksheet copy. But you should delete the worksheet's values before that, for example by using
Worksheets("copy").UsedRange.Offset(1, 0).ClearContents
or manually clearing the range.

Excel defining range across 100+ sheet tabs, remove duplicates in column for 100+ Sheets

Use case: I want to copy data from column A to Column B (where column A, B are arbitrary columns). Once the data is in Column B, I want to remove duplicate entries within column B.
Make a loop that moves data from column A to column B and then removes duplicates for each sheet in a workbook.
`Sub Copy()
For i = 1 To Sheets.Count
Worksheets(i).Range("A1:A100")
Destination:=Worksheets(i).Range("B1")
Next
End Sub
`
For testing I separated the tasks into two different Sub(). Sub Copy() is working and correctly copies my data. Sheet1 is also named "Sheet1" for my specific workbook
`Sub RemoveStuff()
Dim rng As Range
For j = 1 To Sheets.Count
Set rng = Worksheets("Sheet1").Range(Range("B1"),Range("B1").End(xlDown)).Select
rng.RemoveDuplicates Columns:=(1), Header:=xlGuess
Next
End Sub
`
My error seems to be in defining the range correctly. Each sheet will have a different number of entries to remove duplicates from. Sheet1 might have 50 rows and reduce to 6. Sheet2 could have 70 and reduce to 3. Sheet3 could have 20 rows and reduce to 12 uniques. Excel does not let you remove duplicates from range (B:B!)
How can I properly define my range so I can remove duplicates in a loop for a dynamically defined range for each sheet(sheet=tabs in workbook)?
EDIT 2-23-17
New code from Y0wE3K
Sub RemoveStuff()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Columns("P:P").RemoveDuplicates,Columns:=1, Header:=xlYes
Next
End Sub
Still does not work. If I manually select Column P before I run the macro, it works. But it only goes for the one sheet I have selected, it does not seem to execute the loop. Definitely does not automatically do each sheet, or prompt me for each one.
EDIT: 3/4
Make sure that you do not have any protected data, I also experienced issues with pivot tables but I think this may be permissions thank you for help.
Your RemoveStuff subroutine can be rewritten as:
Sub RemoveStuff()
Dim ws As Worksheet
For Each ws In Worksheets ' Use Worksheets instead of Sheets,
' in case there are any Charts
'You can just select the whole column, rather than selecting
'specific rows
ws.Columns("B:B").RemoveDuplicates Columns:=1, Header:=xlGuess
Next
End Sub
Sub RemoveStuff()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Columns("P:P").RemoveDuplicates,Columns:=1, Header:=xlYes
Next
End Sub
This code will work. As a final note, please make sure you have no Protected Data, or pivot tables inside of the sheets you need to run the remove script on. For whatever reason that caused mine to fail, but running my script on the correct sheets that are unprotected worked GREAT.

How can I copy & paste entire rows with distinct values to a new sheet on varying cell ranges?

I know there's many StackOverlow Q&A's on copying & pasting from a cell value in VBA. However, I can't seem to make it work for my own project. I want to copy the entire row(s) if it matches the Distinct Store# (non incremental) in Column H into a new sheet (in this code below, "Sheet1") which already has a template layout where I copy/paste the values. The template looks the same on every sheet before any data is filled in, except the first 2 tabs which have the data ("Appointments" and "Invoices").
I came up with the VBA below, but here's the catch- the cell# that it pastes the row(s) (in the code below, "A10") changes based on the Store #. This is because I am copying rows from the 1st sheet ("Appointments") in the workbook from the distinct Store#, then deleting the empty rows above the area where the 2nd sheet ("Invoices") data goes. Some stores may return 10 rows or none at all. The Case, which is the Store #, is currently manually put in one by one. Should it be an array instead?
Anyway...I was hoping to automate the copying/pasting and loop for each store to their sheet. Maybe I'm going about this wrong, but would anyone be kind enough to suggest how to solve my error code "Method or data member not found." as well as provide any suggestions on making my code better for a loop for filtered cell copying to different spots for each sheet.
Simple explanation of my step by step process:
1.Filter Store # from "Appointments" sheet.
2. Copy all rows for that store and paste into a new sheet with template named "Sheet1" in B3.
3. Filter Store # from "Invoices" sheet.
4. Copy all rows for that store and paste into the previously made sheet named "Sheet" under the above rows. (Some stores do not have invoices, so this section is blank/NULL). Paste destination cell for "Invoices" will be different for each store# depending on how many rows they get from the "Appointments" sheet (could be A10 or A25).
5. LOOP- Next store #, next sheet (sheet2).
Sub CopyToNewSheetInv()
Dim i As Range
Dim book As Workbooks
Dim sheet1 As Worksheets
Dim sheet2 As Worksheets
Set book = Workbooks("SampleWorkbookName")
Set sheet1 = Worksheets("AllInvoices")
Set sheet2 = Worksheets("Sheet1")
For Each i In sheet1.Range("H:H")
Select Case i.Value
Case 1243
sheet2.Range("A10").End(xlUp).Offset(1, 0).EntireRow.Value = i.EntireRow.Value
Case Else
End Select
Next i
End Sub
Try this:
Sub CopyToNewSheetInv()
Dim i As Range
Dim book As Workbook
Dim sheet1 As Worksheet
Dim sheet2 As Worksheet
Set book = Workbooks("SampleWorkbookName.xlsx")
Set sheet1 = book.Worksheets("AllInvoices")
Set sheet2 = book.Worksheets("Sheet1")
'iterate only thorugh those cells in H that have data, not all 1.04 million
For Each i In sheet1.Range("H1", sheet1.Range("H" & sheet1.Rows.Count).End(xlUp))
Select Case i.Value
Case 1243,"1243"
sheet2.Rows(sheet2.Range("A10000").End(xlUp).Offset(1, 0).Row).Value = sheet1.Rows(i.Row).Value
Case Else
End Select
Next i
End Sub

VBA Sum between Special Sheets

Hope you are all doing well. Im here because of a question Im trying to solve since this morning and I CANT stand it anymore.
That is the context : I have an excel workbook in which I have different sheets containing different business plans for different countries. My goal is to make a consolidated Income statement with the sum of the criteria (COGS, Net profit, Salaries....) in each sell.
Each cell in the A column corresponds to a criterion and I want the numbers to appear in the B column (Total of all companies for each criterion).
Thats my code : Initially it wasnt like this but thats one of my attempting drafts let me explain below why Im trying this format
Private Sub Consolidated_Income_Statement()
Dim Sheet As Worksheet
Dim Consolidated As Worksheet
For Each Sheet In Sheets
Do While Cells(B2, B152) <> ""
Consolidated = Sum(Call BPs, B152)
GoTo Consolidated
Next
End Sub
Sub BPs()
Dim Sheet As Worksheet
For Each Sheet In Sheets
If Right(Sheet.Name, 50) = "E2016" Then
End Sub
The fact is that I want to sum the cells only of the sheets containing "E2016" and Im trying to create a call button to use it my private sub once I have determined that I only want these E2016 sheets.
And thats how I tried to do it initially
Private Sub Consolidated_Income_Statement()
Dim Sheet As Worksheet
Dim Consolidated As Worksheet
For Each Sheet In Sheets
If Right(Sheet.Name, 50) = "E2016" Then
Do While Cells(B2, B152) <> ""
Consolidated = Sum('I WANT TO SELECT MY E2016, B152)
GoTo Consolidated
Next
End Sub
But nothing is working ! Sorry if these questions are too basic but Im learning VBA on my own for my company since 2 days and Im facing a couple of difficulties ! Thank you very much for your help !
Some thing like below?
Private Sub Consolidated_Income_Statement()
Dim Sheet As Worksheet
Dim Consolidated As Integer
For Each Sheet In Sheets
If Right(Sheet.Name, 5) = "E2016" Then
Consolidated = Consolidated + Application.WorksheetFunction.Sum(Sheet.Range("B2:B152"))
End If
Next
MsgBox "Sum is : " & Consolidated
End Sub

vba excel counta

Cells(4, x) = Application.WorksheetFunction.COUNTA(Workbooks(""DB_Report.xls"").Sheets(x).Range(A:A))
I am trying to get the above function to work.
I am calling the script from the workbook DB_report.xls
This creates a new workbook ("month") and starts filling in the values.
What I am trying to get to is where
cell 4,1 in months has the counta of sheet 1 from DB_report
cell 4,2 in months has the counta of sheet 2 from DB_report
Can anyone reword the line above so when "months is the active work sheet I can call counta from DB_Report
The line before this is
NameSH = Workbooks("DB_Report.xls").Sheets(x).Name and this works fine and returns the name of work sheet x
Thanks
Aaron
Ok for a bit further explicanation
the steps I want to do go some thing like this
select workbook months.xls
select sheet(1)
cell (x,y) = counta( of range A:A , in worksheet("DB_Report") of worksheet (DB_report.xls)
Now I know
Cells(4, x) = Application.WorksheetFunction.COUNTA(sheet(3).range(a:A)
will work with in the active work sheet. So if the active sheet is sheet 1 then that would count up he numbe of cells in sheet 3 of the same workbook. I wanted to know if as well as refrenced sheet and cells in the function I can also refrence a workbook by name.
of course i could swqap to book "DB_Report" save the value to a varible and then swap back to book "Month" and copy it to the cell.
or could I do workbook("month").sheet(y).cells(a,b) = Application.WorksheetFunction.COUNTA(sheet(3).range(a:A)
while in workbook "month"
so really what i need is how do you refrence workbook,sheet and cells all with in a function?
I don't think this is exactly what you were trying to do, but it comes close and is a bit more generalized. It counts up the worksheets in what would be DB_Report.xls and uses that to specify that number of cells in months.xls
If you are running the macro from the DB_Report.xls you don't need to specify anything about that workbook or sheets.
Sub counts()
Dim sheetcounts As Integer
Dim countas() As Integer
Dim index As Integer
Dim wksht As Worksheet
Dim newbook As Workbook
sheetcounts = ActiveWorkbook.Sheets.Count
ReDim countas(sheetcounts)
For Each wksht In ActiveWorkbook.Sheets
countas(index) = Application.WorksheetFunction.CountA(wksht.Range("A:A"))
index = index + 1
Next
Set newbook = Workbooks.Add
newbook.Activate
newbook.ActiveSheet.Range(Cells(4, 1), Cells(4, sheetcounts)) = countas
newbook.SaveAs ("months.xls")
End Sub
It will require any error checking or verification that you need to put into it.
Hi Cheers for the comments, but i finaly worked out what the problem was.
it was simple really I was just missing some formatting
the line below works correctly
cell(x,y) = Application.WorksheetFunction.CountA(Workbooks("DB_Report.xls").Sheets(x).Range("A:A"))