So I have the following excel tabs:
Code 1, Code 2, Code 3, LI, 2015, 2016, 2017, 2018, 2019, output for 2015 etc.
For 2015, I have a table in '2015' tab with 10 rows a list of 3 code and their respective % values. e.g.
ref name yr code 1 % code 2 % code 3 %
12345 NAME 2015 AB 50% CD 37% EF 13%
78901 NAME 2015 AX 54% OD 30% NG 6%
26572 NAME 2015 AE 60% CD 27% PF 13%
I need the code 1 'AB' and % '50%' to be put into cells B5 and B6 in the tab Code 1. Same for codes 2 and 3 'CS' and '37%' in B5 and B6 in tab Code 2 etc. These then produce an pattern in the LI tab in cells F5:F183 which then needs copying for each reference and pasting into the output for 2015 tab for each reference. Then this loops for each reference and repeats pasting the output.
So far I have this for the copying and pasting part:
Sub Copy_and_paste2()
Dim rng2 As Range, cell2 As Range
Dim i As Integer
i = 3
Set rng2 = Worksheets("2015").Range("D10:D21")
For Each cell2 In rng2
Worksheets("Code 1").Range("B5").Value = cell2.Value
Worksheets("2015 output").Range("A" & i & ":AW" & i).Value = Worksheets("LI").Range("F5:F183").Value
i = i + 1
Next cell2
End Sub
At this point I was just trying to make it work for the first code with no % then I can try add the later ones but this one doesn't work either. Any advice?
Your question is a little hard to read so I've written an answer based on what I think is the most obvious issue with your code. Apologies if I've misread your query or missed the point entirely..
You appear to be trying to copy the contents of
Worksheets("LI").Range("F5:F183") (179 cells)
to
Worksheets("2015 output").Range("A" & i & ":AW" & i) (49 cells)
Ignoring the fact that you can't copy 179 entries into 49 (it will only copy the first 49) - I think you are probably seeing the first entry repeated across all 49 cells?
This would be because you're not transposing the range (in this case, switching from a column to a row).
Try something like this to Transpose:
Worksheets("2015 output").Range("A" & i & ":AW" & i).Value = _
WorksheetFunction.Transpose(Worksheets("LI").Range("F5:F57").Value)
Keep in mind though, I've changed the source range to just the first 49 cells. You don't have to but I'm highlighting it in case you weren't aware this is happening.
Related
I have this data
Date Data
8/25/2017 980
8/24/2017 64
8/23/2017 593
8/22/2017 595
8/21/2017
8/20/2017
8/19/2017 794
8/18/2017 437
8/17/2017
8/16/2017
8/15/2017
8/14/2017 629
What if i wanted (794-595)/3 in cell 21st August and 2*(794-595)/3 in cell 22nd August and similarly (629-437)/4 in 17th August, 2*(629-437)/4 in 16th August etc...
How to do this dynamically without regard to the number of missing values in between
The code below provides one solution, and the animated gif shows the code solving your problem. Of course, there are many ways of solving this problem, but this is simple. At least this shows you what inputs will be needed. It assumes the x-values increment by 1 (as you have in your data). Otherwise you'd need to use something like the slope & intercept functions.
Option Explicit
Sub interpolate()
Dim r As Range, cell As Range
Set r = Application.InputBox("select interpolation range", , , Type:=8)
For Each cell In r
If cell = "" Then
cell = r(1) + (r(r.Rows.Count) - r(1)) * (cell.row - r.row) / (r(r.Rows.Count).row - r(1).row)
End If
Next
End Sub
My situation is the following: I have a table in which there are codes of working shifts i.e. :
John | 1 | 34 | 1 | 34 | Total: | 40 <----
Maria| 1 | 1 | 1 | 1 | Total: | 32 <----I need a formula for this last cell
Every one of this codes has hours amount set in another table.
Codes | Hours
1 | 8
34 | 12
I need to calculate the total amount of work hours based on the codes. I have found ways to map the values to the other table with INDEX and MATCH but when I try to do it for a lot of rows it just gives me the first code mapped, not an array with the mapped values.
I think what will help is the following custom VBA function(see example below). Use as follows:
=multipleMatch(range of cells to look in, range of cells to INDEX, range of cells to MATCH)
Let me know if you have any questions.
Function multipleMatch(inputRng As Range, indexRng As Range, matchRng As Range) As Double
On Error GoTo errhandle
Dim runTot As Double
runTot = 0
Dim cll As Range
Dim mtch As Long
For Each cll In inputRng
If Not IsError(cll.Value) Then
On Error Resume Next
mtch = Application.WorksheetFunction.Match(cll.Value, matchRng, 0)
On Error GoTo errhandle
If mtch <> 0 Then
runTot = indexRng(mtch) + runTot
End If
End If
mtch = 0
Next cll
multipleMatch = runTot
Exit Function
errhandle:
multipleMatch = CVErr(xlErrValue)
Exit Function
End Function
Is there a reason why you have upper table going to the right?
Is there more than John in it?
If the upper table is the record of actually worked shifts, and the bottom one is the default working hours by shift code, and you plan on having more people, then i could suggest the following solution that will also re-organises your tables a little bit, and utilises Excel tables which will allow you to avoid having to maintain the formulas and ranges:
select your Bottom table range, press Ctrl+t which will turn it into
a blue table.
Rename columns just for this example to work - you can rename after you're done with steps here.
your "upper" table gets transposed, having 3 columns Name, Shift Code, Hours.
Do the same thing with it: select range, press ctrl+t, tick "Table has Headers" in the pop-up window. Rename columns as in picture.
in the 1st cell of Hours Column of table 2 (as in picture), paste this formula and hit Enter. (Now is a good time to change column names to your preference)
=SUMIF(Table1[Shift Code],[#[Shift Code]], Table1[Default Hours])
Create a pivot table of Table #2 next to it or wherever you ened it.
If you add data to tables 1 and 2, formulas will update automatically in table 2, and pivot table source. Refresh pivot table to see updated totals.
this is what it would look like.
I hope this is what you tried to achieve.
and if you want, you can put Shift Code into Columns area of pivot table as in the picture below, and have it broken down by code as well as a grandtotal:
*****P.S. Please remember to mark the most useful answer as "Answer" and vote up if other answers or comments were helpful*****
I'm working on Social Survey project.Due to discrepancies in data I'm stuck at a certain place. The survey conducting volunteers were given tablets with unique IDs. On different dates, the tablets were used in different cities
Sheet 1 one contains a list of around thousands of responses for which city names are missing and Sheet 2 contains a list of tablets in use in different cities on different dates.
Sheet 1
City DeviceID StartDate EndDate
Delhi 25 21-08-2014 26-08-2014
Mumbai 39 14-05-2014 21-05-2014
Chennai 91 17-11-2014 21-11-2014
Bangalore 91 11-10-2014 21-10-2014
Delhi 91 26-05-2015 29-05-2015
Hyderabad 25 23-05-2015 28-05-2015
Sheet 2
S.Id DeviceId SurveyDate City
203 91 15-10-2014 ?
204 25 24-08-2014 ?
I need to somehow fill up the values for the city column in Sheet 2.
I tried using Vlookup but being a beginner to excel, was unable to get things working. I managed to format the string in date columns as date.
But am unsure about how to pursue this further.
From my understanding, Vlookup requires that the date ranges to be continuous, with no missing values in between. It is not so in this case. This is real world data and hence imperfect.
What would be the right approach to this problem ? Can this be done with excel macros ?
I also read up a bit about nested if statements but am confused being a beginner to excel formulas and data manipulation.
There is two ways to do what you want.
The first one is using vba and create a macro to do the job BUT you will have to iterate through all your data multiple time (n1*n2 loops in the worst case scenario where n1 and n2 is the number of rows in it's table respectively) which is really slow if you have a lot of data.
The other way is a little more complicated and includes array formulas but is really faster than vba because it uses the build in functions of excel (which are optimized already).
So I will use a much simpler example and you can use that as you wish on your data.
I have the following tables:
Table1
city ID start end
A 1 3 5
B 3 4 6
C 3 5 8
Table 2
ID point city
3 5 ?
So we want a formula that completes the second table. where ID match exactly and point is between start-end. We are going to use MATCH and INDEX to get it.
Here it is:
=INDEX(A$2:A$4;MATCH(1;(B$2:B$4=G2)*(C$2:C$4<=H2)*(D$2:D$4>=H2);0))
First of all to run this after you write it you should not press enter but instead ctrl+shift+enter to tell excel to run it as an array formula otherwise it will not run at all.
Now we got that out of the way let me explain what is going on here:
The MATCH does the following:
match the value 1 (TRUE) in the range I created and that should be an exact match. But how the range is created? Lets take that part for example:
This B$2:B$4=G2 -gives-> {1;3;3}=3 --> {FALSE;TRUE;TRUE}
Similarly the second thing in the MATCH gives: {TRUE;TRUE;FALSE}
So now we have (keep in mind that the * is similar to logical AND):
{FALSE;TRUE;TRUE}*{TRUE;TRUE;FALSE} --> {FALSE;TRUE;FALSE}
and this combined with the third gives {FALSE;TRUE;FALSE}
So now we have MATCH(1;{FALSE;TRUE;FALSE};0) --> 2 because in the range only the second row matches the 1 (first row that it matches).
So now we just use index to get from another range whatever is on row 2.
You can use the above on your own data to get the expected results.
Good luck!
If the deviceId values should match and the survey date should be between the start date and end date, VLookup won't suffice. The following pointers, however, should get you started:
1) Define the date ranges from which the date comparisons should be made.
2) Use an overlap date checking function to determine if the date in question overlaps the start and end dates.
3) Loop through the date ranges and insert in Sheet2 when a match is found, i.e. when the deviceId values match and the date overlaps.
The following function takes as parameters the date to be checked, the start and end date and returns True, if dateVal overlaps the start and end date:
Function dateOverlap(dateVal As String, startDate As String, endDate As String) As Boolean
If DateDiff("d", startDate, dateVal) >= 0 And DateDiff("d", endDate, dateVal) <= 0 Then _
dateOverlap = True
End Function
Example usage
Debug.Print dateOverlap("05-10-2016", "01-10-2016", "10-10-2016") (returns true).
Here we use MEDIAN() as an easy way to test for "in-between".
Sub FillInTheBlanks()
Dim s1 As Worksheet, s2 As Worksheet
Dim N1 As Long, N2 As Long, i As Long, j As Long
Dim rc As Long, DeId As Long, sDate As Date
Dim wf As WorksheetFunction
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
Set wf = Application.WorksheetFunction
rc = Rows.Count
N1 = s1.Cells(rc, "A").End(xlUp).Row
N2 = s2.Cells(rc, "A").End(xlUp).Row
For i = 2 To N2
DeId = s2.Cells(i, "B").Value
sDate = s2.Cells(i, "C").Value
For j = 2 To N1
If DeId = s1.Cells(j, 2).Value Then
If sDate = wf.Median(sDate, s1.Cells(j, "C").Value, s1.Cells(j, "D").Value) Then
s2.Cells(i, "D").Value = s1.Cells(j, "A").Value
End If
End If
Next j
Next i
End Sub
Sheet2:
starting from Sheet1:
I want you to have some fun. I need something specific.
First i must explain what i do. I use a simple codification for product prices at retail store, because i dont want people know the real price for themselves. So i change the original numbers to another subtracting the number 9 for each number.
Normally I manually write down all the prices with this codification for every product.
So.. for example number 10 would be 89. (9-1 = 8) and (9-0 = 9)
Other examples:
$128 = 871
$75 = 24
$236 = 763
$9 = 0
Finally i put 2 number nines (9) at the beginning of the codified price also, to confuse people who might think that number could be the price.
So the examples i used before are like this:
99871 (means $128)
9924 (means $75)
99763 (means $236)
990 (means $9)
Remember that i need 2 (two) nines before the real price. The real prices never start with 0 so, the nines at the beginning exist only to confuse people.
Ok. So, now that you understand, here comes the 2nd part.
I have an excel whith hundreds of my products added, with prices, description, etc. And i decided it is time to use a printer and start to print this information from excel. I have a software to do that, but first i need to have the codified prices in the excel also.
The fun part begins when i want to convert the real prices that are already written in my excel document into a new column AUTOMATICALLY. So that way i don´t have to type again all the prices in codified form for the old and new items i add in the future.
Can someone help me with this? Is it even possible?
I tried with =A1-9999 but, it works well with 2 character number only. Because if the real price is 5, i will get 3 nines: 9994(code). And if the price is 234 i will get only 1 nine 9765(code). And it is a condition i need to have the TWO nines at first.
Thank you very much in advanced!
Though you have requested for formula , I am suggesting VBA program which seems to me very convenient.
You have to open VBE and insert a module and copy the program. Change the code lines wherever indicated to suit your requirements for sheets etc.
Sub NumberCode()
Dim c As Range
Dim LR As Integer
Dim numProbs As Long
Dim sht As Worksheet
Dim s As Integer
Dim v As Long
Dim v1 As Long
Set sht = Worksheets("Sheet1") ' change as per yr requirement
numProbs = 0
LR = sht.Cells(Rows.Count, "A").End(xlUp).Row
For Each c In sht.Range("A1:A" & LR).Cells
s = Len(c)
v = c.Value
v1 = 99
For s = 1 To Len(c)
v1 = v1 & (9 - Mid(c, s, 1))
Next
c.Offset(0, 1).Value = v1
v1 = 99
numProbs = numProbs + 1
Next
MsgBox "Number coding finished"
End Sub
Sample sheet of results is appended below.
I will be using helper cells but you could dump it all into one cell if you want since you are only dealing with 4 characters.
For the purpose of this example, I am assuming your original price list starts in B11.
=IFERROR(9-MID($B11,COLUMN(A1),1),"")
Place that in D11 and copy to the right three more times so you have it from D11 to G11. That formula strips off 1 character from your price and subtracts that character from 9. When you go the next column it repeats itself. If you do not have that many characters, it will return "".
In C11 you will build your number based on the adjacent 4 columns using this formula:
="99"&D11&E11&F11&G11
It places 99 in front then adds the numbers from the adjacent 4 columns.
Select cells C11 to G11 and copy and paste downward beside your data column as far as you need to go.
An alternate more concise method would be:
=REPT(9,LEN(B11)+2)-B11
Perhaps I'm missing something, though simply:
=REPT(9,2+LEN(A1))-A1
seems good to me.
Regards
I have a large data set that is exported from a website. I use a macro in my main ‘filter’ workbook to find the file and copy the data from Sheet1 of the exported file into Sheet1 of the filter workbook.
Once the data is copied into Sheet1 of the filter workbook, I use VBA to copy columns A/B/D/F/H/Z/AA/etc from Sheet 1 of the filter workbook into Sheet2 of the filter workbook AND also at the same time, I use this code here to attempt to delete any duplicate rows:
Worksheets("Sheet2").Range("A:DZ").RemoveDuplicates Columns:=15, Header:=xlYes
I am finding though that the RemoveDuplicates is not working as expected.
As an example, Sheet1 in the filter workbook (and export workbook) has 3344 rows. When I manually filter using conditional formatting to highlight duplicates, I can find 314 rows listed as duplicates (meaning 157 genuine rows of actual data and 157 rows which are duplicates of that actual data. I haven’t found any examples of duplicates existing more than one time each). So on Sheet2 I was expecting to see 3344 – 157 = 3157 Rows of real data. I don’t see that, or even 3030 rows (3344-314). Instead, I am getting 1897 rows paste into Sheet2, which is a difference of 1447 rows (1290 less rows than expected).
On top of that, I am manually checking the data to see what is up by using Control-F in the column and am finding that in some instances that both of the two duplicated items are missing from Sheet2 (versus it just deleting the one duplicate row).
The duplicate data is not on sequential rows and is scattered throughout the column in Sheet2. But when I sort it before I attempt to DeleteDuplicates, it does not seem to impact its accuracy or make it right.
I have also tried using the DeleteDuplicates in different locations of the code / at different times but the results are always off by the same amount (1447 missing rows instead of 157 missing rows).
I found only a few articles on this site, this one was the closest but not quiet my issue: Delete Rows With Duplicate Data VBA
And other help sites/forums mention there was some bug with office 2007 that prevents this from working (am using 2013).
Does anyone know where I can find a work around, or if one exists - or if this is still a real bug or just a problem with the code line I have above.
Adding bits of code I use in this example in case it is something within these that is causing the problem…
Part of the copy code:
wsFromSheet.Cells.Copy
wsToFile.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
wbFromFile.Close True
Part of the ‘paste column code’:
Sheets("Sheet2").Rows(1 & ":" & Sheets("Sheet2").Columns.Count).ClearContents 'Clear from row 1 down
LastRowFromSiteTracker = xSht.Cells.SpecialCells(xlCellTypeLastCell).Row 'original report has 128 columns
xSht.Range("B1:B" & LastRowFromSiteTracker).Copy ySht.Cells(Rows.Count, "A").End(xlUp) 'customer name
‘repeat a bunch of times, then…
Application.CutCopyMode = False 'do I need this line?
Worksheets("Sheet2").Range("A:DZ").RemoveDuplicates Columns:=15, Header:=xlYes
End Sub
Example/sample of data:
Row Source Data Expected Data Actual Data
1 1000474608 1000474608 1000474608 (Dup missing from sheet2)
2 1000474608 1000487672 1000487672
3 1000487672 1000487674 1000487674
4 1000487674 1000487676 1000487676 (missing from sheet2, wasn’t a dup)
5 1000487676 1000487678 1000487678
6 1000487678 1000487680 1000487680
7 1000487680 1000487682 1000487682 (Dup missing from sheet2)
8 1000487682 1000520278 1000520278
9 1000487682 1000520280 1000520280
10 1000520278 1000520282 1000520282 (Is there)
11 1000520280 1000520286 1000520286
12 1000520282 1000520336 1000520336 (Is there)
13 1000520282 1000520338 1000520338
14 1000520286 1000520392 1000520392
15 1000520286 1000520394 1000520394
16 1000520336 1000530333 1000530333
17 1000520338
18 1000520392
19 1000520394
20 1000530333
EDIT: EDIT: EDIT:
So I've tried to do some more manual testing, and tried two separate things with the same set of data, getting two different results. I used the Conditional Formatting - Highlight Duplicates from the main Home ribbon and the Remove Duplicates from the Data ribbon.
The Remove Duplicates button finds and removed 163 items in Column P and leaves 3181 rows.
However, when I use the Highlight Duplicates conditional format finds 314 items that are duplicated within Column P, leaving 3030 non duplicates.
It does not make sense that these two numbers do not match. I thought it has something to do with the duplicates themselves - as most duplicated items have only one dup of itself (123123 shows up in two rows) but then just a small handful of rows are duplicated multiple times (234234 shows up in 4 or 6 columns).
So instead of using the manual way, I used the suggestions I've found online, and both of these also provide differing results when run:
3344 Base records
1897 left after scrub of duplicates (1446 removed)
Dim tmpAddress As String
tmpAddress = "A2:BZ" & Worksheets("ColScrub").UsedRange.Rows.Count
Worksheets("ColScrub").Range(tmpAddress).RemoveDuplicates Columns:=15, Header:=xlNo
3181 left after scrub of duplicates (162 removed)
Cells.Select
ActiveSheet.Range("$A$1:$EI$3345").RemoveDuplicates Columns:=31, Header:=xlYes
My further experience now shows that UsedRange is completely unreliable if you have blank rows or columns. UsedRange only includes rows/columns up to the blank one. I have found a better way to get the last of each. These function use 2 basic assumptions, which should hold true for mostof your spreadsheets.
For LastRow there is a "key" column, i.e. a column where the MUST be
data, for example an ID column
For LastCol there should be a header row (or row where you can guarantee the last column is filled)
With this in mind, I have created the following 2 functions retrieve the last values accurately, every time ... well, almost (my complete function handles issues of the footer rows with merged cells)
For the last row
Public Function Excel_GetLastRow(xlSheet As Excel.Worksheet, _
ByVal KeyColumn As Long) As Long
' This could be adjusted for exact max rows Excel allows
Const MAX_XL_ROWS As Long = 1048000
Excel_GetLastRow = xlSheet.Cells(MAX_XL_ROWS, KeyColumn).End(xlUp).row
End Function
And for last column
Public Function Excel_GetLastCol(xlSheet As Excel.Worksheet, _
ByVal HeaderRow As Long) As Long
' This could be adjusted for exact max columns Excel allows
Const MAX_XL_COLS As Long = 16000
Excel_GetLastCol = xlSheet.Cells(MAX_XL_COLS, HeaderRow).End(xlToLeft).Column
End Function
Using these values you can now set your complete data range successfully.
top left = Cells(HeaderRow + 1, 1)
bottom right = Cells(LastRow, LastCol)
My complete functions include error handling and allowances for possible merged cells in the footer row and last header column, but you get the idea.
Art
1) you are only clearing as many rows as your have columns, not rows
Also, you may not be clearing anything, so use the UsedRange.Rows for proper rowcount
This line ...
Sheets("Sheet2").Rows(1 & ":" & Sheets("Sheet2").Columns.Count).ClearContents
Should read ...
Sheets("Sheet2").Rows(1 & ":" & Sheets("Sheet2").UsedRange.Rows.Count).ClearContents
Without properly clearing the old data, unpredictable results may occur.
2) Excel VBA seems rather quirky in that many things won't work correctly without specifically "selecting" the object(s) in question AND specifiying complete (not columnar) ranges
3) I also prefer to leave out the header row (note the "A2") and pass Header:=xlNo
4) Unless you have more than 625 columns, BZ should be far enough
So add this to your code ...
Dim tmpAddress as String
tmpAddress = "A2:BZ" & Worksheets("Sheet2").UsedRange.Rows.Count
Worksheets("Sheet2").Activate
Worksheets("Sheet2").Range(tmpAddress).RemoveDuplicates Columns:=15, Header:=xlNo
Hope this helps :)
I don't know why (or if/how) this is any different, but this seems to be the closest I can get to true removal of duplicates. I wanted to add it here as an answer for others in similar situations.
Dim lastrow As Long
With ThisWorkbook.Worksheets("ColScrub")
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lastrow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row 'Change P1 back to A1 if needed
Else
lastrow = 1
End If
.Range("A1:AZ" & lastrow).RemoveDuplicates Columns:=Array(16), Header:=xlYes
End With
I have to go through each row visually to prove this works I think, and to rule out that it isn't deleting things that should not be deleted - but this seems to get rid of the 'double duplicates' (4-6 lines items instead of 2 like the other duplicates).