I'm currently working on 6 Excel workbooks all with same format. Basicly i have a table which includes product codes with their amount needs to be used. I have around 200 worksheets in every Excel file with same format. I want to update these product amount based on multiplier table i made. Here an example of data below;
Sample of data
Multiplier table
So the new values of sample codes should be 4,15 3,5 7,84 and 88,62.
Because the high amount of pages with workbooks, probably changing or inserting some kind of formula one by one would take very long time. I wonder how can I get the job done with few easy steps.
Thanks!
All you need to do is to use VLookup function or array formula. Then you'll be able to fill down or copy formula for every single record.
In your case i'd suggest to use array formula. Assuming, if MultiplierTable is the name of worksheet and that worksheet contains data (as you provided) in a range C4:D7, you can copy below formula and paste it into E4 cell:
=D4*SUM(IF(C4=MultiplierTable!C$4:C$7,MultiplierTable!D$4:D$7,0))
Fill down the formula. Select entire column and paste as values in the same column. Repeat this step for each worksheet.
Follow the links for further details.
In case, you want to use VBA, please let me know. I'll try to improve my answer.
I checked some guides for basics of VBA and created my own VBA script. It became a little hardcoded but because this is one time job, it get the job done.
Sub degistir()
Dim WS_Count As Integer
Dim I As Integer
Dim val As Double
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
Worksheets(I).Activate
For R = 8 To 14
val = ActiveSheet.Cells(R, 4)
If ActiveSheet.Cells(R, 2) Like "P001" Then
val = val * 1
ElseIf ActiveSheet.Cells(R, 2) Like "P002" Then
val = val * 0.533333333
'and goes...
End If
ActiveSheet.Cells(R, 4).Value = val
Next R
Next I
End Sub
Related
Requesting some help from you more advanced excel VBA wizards.
Situation: I work as a medical administrator of sorts. HIPPA is obviously a concern for me as my personal tracker does contain a lot of HIPPA, and the whole "need to know" bit is a big deal. I need to have a workbook available for my subordinate staff to see without violating HIPPA
I have a workbook with a lot of data. I would like a separate workbook (Book2) to pull names from column A(the patients unit) and B(their name) if they meet a number or text condition from a separate column (let's call it column D).
I know I can filter, then copy/paste the list or data that is needed for them, but that is time consuming for 5 separate units with 100+ patients each. If at all possible, I would prefer to share Book2 with the option for them to leave comments next to the name. The idea is to just update BookA, so the can have the most up to date names in real time.
I've tried VBAs and customizing them to my criteria , but cant seem to find anything that works. Any help is appreciated.
*OP note - I'm still very much a novice at this whole macro thing. I'm not to the point of writing any code of my own yet, just stealing other people efforts. Which has been done successfully in previous needs.
The following code should get you started (Run from Book2);
Sub CopyIfCriteria()
'Get other workbook and worksheet
Dim wb As Workbook
Set wb = Excel.Workbooks("BookA.xlsx")
Dim ws As Worksheet
Set ws = wb.Worksheets("Sheet1")
'Column 1 = A
Dim unit As Long
unit = 1
'Column 2 = B
Dim name As Long
name = 2
'Column 4 = D
Dim criteria As Long
criteria = 4
'Row 1 = 1, change if headers
Dim firstRow As Long
firstRow = 1
'Row n = last row with data
Dim lastRow As Long
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
'Current row index on BookA, starts at first row
Dim copyIndex As Long
copyIndex = firstRow
'Current row index on Book2, starts at row 1
Dim pasteIndex As Long
pasteIndex = 1
For copyIndex = firstRow To lastRow
'Change what the condition is to check if criteria is correct
If (CBool(ws.Cells(copyIndex, criteria).Value) = True) Then
'Copy unit and name to the next available row on Book2; pasteIndex
ws.Cells(copyIndex, unit).Copy Cells(pasteIndex, unit)
ws.Cells(copyIndex, name).Copy Cells(pasteIndex, name)
'Use pasteIndex to find what row we're up to on Book2, increment everytime we use a row
pasteIndex = pasteIndex + 1
End If
Next copyIndex
End Sub
This will simply get the BookA workbook, assuming it is opened in Excel, and then iterate through every row. If column D (4) has the correct criteria, then it'll copy column 1 and 2 (A & B) of that row to the next un-used row in Book2.
You will ned to have a blank Excel file (from which the code is run) open, as well as having BookA open (and having the data on Sheet1) of BookA. If they're not in 'BookA.xlsx' or 'Sheet1' then simply change the names to suit your needs.
Do take the time to just read through it and take not of the comments to help you understand better how it is doing it.
I have a worksheet that uses randomly generated numbers in calculations to produce results in two adjacent cells (let's say A1 and A2). I am trying to perform 100 iterations where I'm simply "Calculating Formulas" on the worksheet and then trying to store the results of each iteration next to A1 and A2 (so iteration 1 would be in B1 and B2 and iteration 100 would be in CW1 and CW2). Thanks in advance for your help. Using Excel 2010 if that matters.
Dim Iteration As Integer, i As Integer
Dim val As Variant
Iteration = 100
For i = 1 To Iteration
Calculate
Range("A1:A2").Select
Selection.Copy
Range("B" & Rows.Count).End(x1Up).Offset(0, 1).PasteSpecial
Paste:=xlPasteValues
Next i
End Sub
I think your major problem was with the location you were selecting for the destination address - you were finding the last unused cell in column B, then shifting over one column (i.e. to column C) and pasting the first set of results. Then you were using that same location for the second set of results, etc.
Sub Test()
Dim Iteration As Integer, i As Integer
Dim val As Variant
Iteration = 100
'Use a "With" block so that it can be easily changed in the future
'to refer to a specific sheet if needed
With ActiveSheet
For i = 1 To Iteration
Calculate
'Determine the last used column on row 1,
' offset 1 column to the right,
' resize to refer to 2 rows,
' set values to the values in A1:A2
.Cells(1, .Columns.Count).End(xlToLeft).Offset(0, 1).Resize(2, 1).Value = .Range("A1:A2").Value
Next i
End With
End Sub
As pointed out by Steve Lovell, you also had a typo in your original code. It is a good habit to include Option Explicit as the first line in every code module. That will force you to declare all the variables that you use, and the compiler would have highlighted x1Up and given a "Variable not defined" error.
I should note that there are related solutions to my question online but I've been unable to implement them into my own situation.
We have an .mdb database of all the products that we make. I've managed to take two criteria (Order type and Box), and print all records containing those two criteria to Excel. What I need in addition to that now is to print 30 boxes in one go as a basis for a bigger template. The labeling of these boxes usually increment (e.g. P1, P2...P30), and I'm struggling to see how I can increment the numeric portion of it to fit it into my code. Ideally, I'd like for the user to input the first and last box numbers in excel to represent the entire range (P1 and P30) and use those two values.
Sub Dan()
Dim order As String
Dim title As String 'initialize title
Dim palette As String 'intialize comment
Dim finalpalette As String
Dim finalrow As Integer 'initialize bottom-most row
Dim i As Integer
Dim Cntr As Integer
Dim LR As Integer
'Clears the contents of the last macro run
With Sheets("ALL.txt")
.Range(.Cells(6, 2), .Cells(725, 8)).ClearContents 'equates to (D2:F26)/ row, column ;Erase Columns for next macro
End With
title = Sheets("Sheet2").Range("B1").Value
palette = Sheets("Sheet2").Range("B2").Value
finalrow = Sheets("Sheet1").Range("A2").End(xlDown).Row
For i = 3 To finalrow
If Cells(i, 1) = title And Cells(i, 2) = palette Then
Cells(i, 5).Copy 'Copy ID
Sheets("ALL.txt").Range("B734").End(xlUp).Offset(1, 0).PasteSpecial
Range(Cells(i, 11), Cells(i, 14)).Copy
Sheets("ALL.txt").Range("C734").End(xlUp).Offset(1, 0).PasteSpecial
Range(Cells(i, 9), Cells(i, 10)).Copy
Sheets("ALL.txt").Range("G734").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next i
End Sub
The variable I'm looking to adjust is 'palette'. I originally used it to match records to one Box (P1). What I need is to able to match records from 30 boxes (P1 to P30) in the loop. The variable 'palette' is just taking the static value of whatever is in cell B2 at the moment. I'm thinking there should be some way to type the first and last box into two cells to establish a range for the macro to iterate, or to write all the box numbers into a column and have 'palette' move down a cell each loop to take in a new Box value.
In an attempt to grab data from a column that has all 30 boxes written into 30 cells, I tried the following line of code
End If
palette = Sheets("Sheet2").Range("B2").Offset(, 1)
Next i
but it does not seem to be grabbing any value. It should be grabbing values from cells B2 to B31.
Here is some code that I changed (still no clue as to why you're breaking this up into 3 parts, seems like excel VBA is an extra step that complicates it).
thisworkbook.worksheets(1).cells(i,5) Use full references when learning VBA
let me know if this works, I don't know enough about your situation to know exactly what you need, other than what I can see you're trying to do.
Sub Dan()
Dim Order As String
Dim Title As String 'initialize title
Dim Palette As String 'intialize comment
Dim Fpalette As String
Dim Frow As Integer 'initialize bottom-most row
Dim i As Integer
Dim Cntr As Integer
Dim LR As Integer
Dim wsALL As Worksheet
'Clears the contents of the last macro run
With Sheets("ALL.txt")
.Range(.Cells(6, 2), .Cells(725, 8)).ClearContents 'equates to (D2:F26)/ row, column ;Erase Columns for next macro
End With
Title = Sheets("Sheet2").Range("B1").Value
Palette = Sheets("Sheet2").Range("B2").Value
Frow = Sheets("Sheet1").Range("A2").End(xlDown).Row
Set wsALL = Sheets("ALL.txt")
i = 2
Do While i < Frow
i = i + 1
If ThisWorkbook.Worksheets("Sheet1").Cells(i, 1) = Title And ThisWorkbook.Worksheets("Sheet1").Cells(i, 2) = Palette Then
Sheets("Sheet1").Cells(i, 5).Copy Destination:=wsALL.Range("B734").End(xlUp).Offset(1, 0)
'wsALL.Range("B734").End(xlUp).Offset(1, 0).PasteSpecial
Sheets("Sheet1").Range(Cells(i, 11), Cells(i, 14)).Copy Destination:=wsALL.Range("C734").End(xlUp).Offset(1, 0)
'wsALL.Range("C734").End(xlUp).Offset(1, 0).PasteSpecial
Sheets("Sheet1").Range(Cells(i, 9), Cells(i, 10)).Copy Destination:=wsALL.Range("G734").End(xlUp).Offset(1, 0)
'wsALL.Range("G734").End(xlUp).Offset(1, 0).PasteSpecial
End If
Loop
End Sub
Ignore the Below, I was going to make this way more complicated than necessary. Looking at your code, be sure to reference using
Hi Joshua,
I'm not sure I completely understand what you're trying to accomplish, adding in more details such as the first macro may help in getting you a specific answer. I think possibly VBA in Excel may not be the best way. A VBA in Access sounds possible solution. But this may be of help to you.
I know you said for an end user, It would be much more complicated on your part but I've had great success using microsoft query to import data, with the correct ODBC driver "Access Database Engine" http://www.microsoft.com/en-us/download/details.aspx?id=13255 it works great now and I use it to get data from flat files then send it to SQL based on a query, but I fought with it to get it to work you will rip your hair out and it wouldn't be portable to an end user
Having a user enter a value into a specific cell could work, i.e. put a value in A1 and VBA can check that value using:
Alpha = Cells(1,1).Value
pStart = Cells(2,1).Value 'A2
pEnd = pStart + 30
In order to prevent any issues with spaces this could be done as:
set pStart = Trim(ActiveCell(2,1).Value)
Or another way is to use data validation and give users a drop down list. https://support.office.com/en-ca/article/Create-or-remove-a-drop-down-list-5a598f31-68f9-4db7-b65e-58bb342132f7
Here is the code if for either way. Notice I've made some edits, most are not essential changes, just how I write VBA. When you use the copy -> paste command it avoids the clipboard if you say .Copy Destination:= Another comment, this would be so easy in Access simply write an SQL statement and use the append feature. You say that you have a macro before this, and after this, I would say make it one (very powerful and nice) SQL statement what is run through a user form.
I have an excel book that has two sheets: 1) Import 2) Pricing Rules.
Pricing Rules Sheet
The A column is what I need to match on. Example values include STA_PNP4, STA_PST.. and others. There are potentially around 50 different rows in the sheet, and it will continue to grow over time. Then for each row, there are pricing values in columns B to CF.
Import Sheet
This sheet has the same number of columns, but only Column A is filled out. Example values include STA_PNP4_001_00, STA_PNP4_007_00, STA_PST_010_00.. and many more.
What I need to do:
If the text in Import Sheet Column A before the second "_" matches the column identifer in Pricing Rules Sheet Column A, copy the rest of B to CF of Pricing Rules sheet for that row into the Import sheet for the row it matched on.
Any idea on where to begin with this one?
Why don't you do it using formulas only?
Assuming :
1.) Data in Import Sheet is
(col A)
STA_PNP4_007_00
STA_PNP4_001_00
STA_PNP4_001_00
.
.
2.) Data in Pricing Rules Sheet
(Col A) (col B) (ColC) (Col D) .......
STA_PNP4 1 2 3 .....
STA_PST 4 5 6 .....
STA_ASA2 7 8 9 .....
Then write this formula in B1 cell of Import Sheet
=IFERROR(VLOOKUP(LEFT(A1,FIND("",A1,FIND("",A1)+1)-1),PricingRules!$A$1:$CF$100,2,0),"")
Drag it down in column B
and For Column C , D just change index num from 2 to (3 for C) , (4 for D) and like that.
Because it will continue to grow over time you may be best using VBA. However, even with code I would start by applying the ‘groups’ via formula, so as not to have a spreadsheet overburdened with formulae and hence potentially slow and easy to corrupt. Something like part of #xtremeExcel’s solution which I repeat because the underscores have been treated as formatting commands in that answer:
=LEFT(A1,FIND("_",A1,1+FIND("_",A1))-1)
I’d envisage this (copied down) as an additional column in your Import Sheet - to serve as a key field to link to your Pricing Rules Sheet. Say on the extreme left so available for use by VLOOKUP across the entire sheet.
With that as a key field then either:
Write the code to populate Pricing Rules Sheet as frequently as run/desired. Either populating ‘from scratch’ each time (perhaps best for low volumes) or incrementally (likely advisable for high volumes).
Use VLOOKUP (as suggested). However with at least 84 columns and, presumably, many more than 50 rows that is a lot of formulae, though may be viable as a temporary ‘once off’ solution (ie after population Copy/Paste Special/Values).
A compromise. As 2. But preserve a row or a cell with the appropriate formulae/a and copy that to populate the other columns for your additions to your ColumnA and/or ColumnA:B.
Thanks for the input guys.
I got it implemented via a method like this:
{=VLOOKUP(LEFT($A4,7),PricingRules!A3:CF112,{2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84},FALSE)}
That is my ugly function, applied across a whole row, to look up and copy from my pricing rules every column when it finds a match.
Below is the function that I have created for above scenario. Its working as per the requirement that you have mentioned.
Sub CopyData()
Dim wb As Workbook
Dim importws As Worksheet
Dim PricingRulesws As Worksheet
Dim Pricingrowcount As Integer
Dim importRowCount As Integer
Dim FindValue As String
Dim textvalue As String
Dim columncount As Integer
Dim stringarray() As String
'Enter full address of your file ex: "C:\newfolder\datafile.xlsx"
Set wb = Workbooks.Open("C:\newfolder\datafile.xlsx")
'Enter the name of your "import" sheet
Set importws = Sheets("Import")
'Enter the name of your "Pricing" sheet
Set PricingRulesws = Sheets("PricingRules")
For Pricingrowcount = 1 To PricingRulesws.UsedRange.Rows.Count
FindValue = PricingRulesws.Cells(Pricingrowcount, 1)
For importRowCount = 1 To importws.UsedRange.Rows.Count
textvalue = importws.Cells(importRowCount, 1)
stringarray = Split(textvalue, "_")
textvalue = stringarray(0) & "_" & stringarray(1)
If FindValue = textvalue Then
For columncount = 2 To PricingRulesws.UsedRange.Columns.Count
importws.Cells(importRowCount, columncount) = PricingRulesws.Cells(Pricingrowcount, columncount)
Next columncount
End If
Next importRowCount
Next Pricingrowcount
End Sub
I have an XL file with some data to be manipulated. I think I will need to use a VB script to do this - but perhaps there is a simpler way with a formula. Just the same, could someone point out BOTH ways of achieving the following?
I have a column of numeric values (ID) in Sheet 1.
I want to use each ID as an index to lookup a list in Sheet 2.
Sheet 2 has two columns
First column is the index and Second column is the Text String
e.g.
1 Apple
2 Orange
3 Pear
What I want is to replace the column of IDs in sheet 1 with the looked up text string from Sheet 2!
Thats all...
Please help!
Not a tough situation there. Here are some solutions...
With VBA:
I know you said you're a little new with VB so I tried to explain each line as I went along. Also, the code is free-handed so forgive me if I left an error in there somewhere.
Sub replaceData()
dim i as integer, j as integer 'These are just some variables we'll use later.
dim sheetOne as worksheet, sheetTwo as worksheet, myWb as workbook
dim myData as string, myId as string
set myWB = excel.activeworkbook 'These three lines set your workbook/sheet variables.
set sheetOne = myWB.worksheets("Old Data")
set sheetTwo = myWB.worksheets("New Data")
for i = 1 to sheetTwo.usedrange.rows.count 'This loops through the rows on your second sheet.
myId = sheetTwo.cells(i,1).value 'This assigns the value for your id and the data on your second sheet.
myData = sheetTwo.cells(i,2).value
for j = 1 to sheetOne.usedrange.rows.count 'This loops through the rows on your first sheet.
if sheetOne.cells(j,1).value = myId then 'This checks each row for a matching id value.
sheetOne.cells(j,1).value = myData 'This replaces that id with the data we got from the second sheet.
end if
next j
next i
end sub
With an Excel formula:
Place the following formula in cell C1 of the first worksheet (the
sheet with the IDs you will be replacing). **Note that you will
have to replace the "InsertSheetTwoNameHere" portion with the name
of your second sheet (don't remove those single quotes though). Also
note you will need to replace the "1000" with the number of the last
used row in sheet two.
=vlookup(A1,’InsertSheetTwoNameHere’!$A$1:$B$1000,2,FALSE)
Next simply drag the handle on the cell that makes it copy itself
(whatever the heck it's called) all the way down to the end of your
range.
Next, copy those cells and then paste them over the IDs using the
Values Only setting.
Hope this helps and good luck.