I have to create output XLS file based on input xls file header. I am giving below exact requirement. hope its clear. if not then please let me know.
Iput XLS -->
ID Version NameLegacy ProjectNumber OwnerName Language Keywords OwnerSite External Content Relevance Periodic Coremap ValidTo
1 1 Mohan 1000 x ENG ABCD AB No ok no 5 2017-10-14 2018-10-14
2 2 Shayam 1001 y ENG EFGH BC No ok yes 2 2017-10-14 2018-10-14
3 1 Sourabh 1002 z ENG IJKL CD Yes no no 4 2017-10-14 2018-10-14
Based on this Input XLS File, i need Output XLS File as below. Each row of input file will have 12 row of output file and respective value will be filled in Output file from input file.
ID Version IBANAME STRINGVALUE INTEGERVALUE FLOATVALUE FLOATVALUEWITHUNITS BOOLVALUE TIMEVALUE URLVALUE REFERENCEVALUE
1 1 NameLegacy Mohan
1 1 ProjectNumber 1000
1 1 OwnerName x
1 1 Language ENG
1 1 Keywords ABCD
1 1 OwnerSite AB
1 1 External No
1 1 Content ok
1 1 Relevance no
1 1 Periodic 5
1 1 Coremap 2017-10-14
1 1 ValidTo 2018-10-14
2 2 NameLegacy Shayam
2 2 ProjectNumber 1001
2 2 OwnerName y
2 2 Language ENG
2 2 Keywords EFGH
2 2 OwnerSite BC
2 2 External No
2 2 Content ok
2 2 Relevance yes
2 2 Periodic 2
2 2 Coremap 2017-10-14
2 2 ValidTo 2018-10-14
3 1 NameLegacy Sourabh
3 1 ProjectNumber 1002
3 1 OwnerName z
3 1 Language ENG
3 1 Keywords IJKL
3 1 OwnerSite CD
3 1 External Yes
3 1 Content no
3 1 Relevance no
3 1 Periodic 4
3 1 Coremap 2017-10-14
3 1 ValidTo 2018-10-14
Thanks in advance.
There are a few steps to do this using VBA. The main purpose is to identify what you are actually trying to do.
It seems like you are attempting to sort through records to identify what the format of the information is and place it in a column designated for only that format. To do this, I have created a very simple custom Function..
This function takes in the name of the header as a string, and uses Select/Case to find appropriate matches for which column the target sheet needs. This is custom to your specific layout. Feel free to adapt or change it.
FUNCTION TO FIND CORRECT COLUMN ON TARGET
Function ColFinder(header As String) As Long
'Target Column Format = Column #
'"STRINGVALUE" = 4
'"INTEGERVALUE" = 5
'"FLOATVALUE" = 6
'"FLOATVALUEWITHUNITS"= 7
'"BOOLVALUE" = 8
'"TIMEVALUE" = 9
'"URLVALUE" = 10
'"REFERENCEVALUE" = 11
' **** SET VALUES FOR CASES TO MATCH DESIRED FORMAT ABOVE ****
'Default to Column 4 StringValue if unknown
Select Case header
Case "NameLegacy"
ColFinder = 4
Case "ProjectNumber"
ColFinder = 5
Case "OwnerName"
ColFinder = 4
Case "Language"
ColFinder = 4
Case "Keywords"
ColFinder = 4
Case "OwnerSite"
ColFinder = 10
Case "External"
ColFinder = 8
Case "Content"
ColFinder = 11
Case "Relevance"
ColFinder = 8
Case "Periodic"
ColFinder = 5
Case "Coremap"
ColFinder = 9
Case "ValidTo"
ColFinder = 9
End Select
End Function
Using a few other Functions for finding Last Row & Last Column
Last Row Function
Function lastRow(sheet As String) As Long
lastRow = Sheets(sheet).Cells(Rows.Count, "A").End(xlUp).Row 'Using Cells()
End Function
Last Column Function
Function lastCol(sheet As String) As Long
lastCol = Sheets(sheet).Cells(1, Columns.Count).End(xlToLeft).Column
End Function
With these three functions, you can run a simple loop through the source sheet, one row at a time, then look to see which column the data is coming from, and place it on the appropriate target.
This example is using two worksheets in the same workbook. To change, just extend the address to include other workbooks or sheets. This is just the simplest way to show the concept.
CODE TO LOOP THROUGH SHEETS
Sub ColsToRows()
Dim tRow As Long, sCol As Long, sRow As Long
Dim source As String, target As String
Dim tString As String
source = "Sheet1"
target = "Sheet2"
'Set target Row starting point
tRow = 2
'Loop through Source Rows with Data, starting after Header Row
For sRow = 2 To lastRow(source)
'Loop through each header in Source Row
For sCol = 3 To lastCol(source)
'Set Basic Columns on Target
Sheets(target).Cells(tRow, 1) = Sheets(source).Cells(sRow, 1)
Sheets(target).Cells(tRow, 2) = Sheets(source).Cells(sRow, 2)
'Get Header Name as Temp String to find which format it requires
tString = Sheets(source).Cells(1, sCol)
'Label Column 3 of Target
Sheets(target).Cells(tRow, 3) = Sheets(source).Cells(1, sCol)
'Find Appropriate Column using custom Formula [ColFinder(header As String) As Long]
Sheets(target).Cells(tRow, ColFinder(tString)) = Sheets(source).Cells(sRow, sCol)
'Advance to next Target Row
tRow = tRow + 1
Next sCol
Next sRow
End Sub
Source Sheet Example
Target Sheet Example
You can convert the upper table to the lower one using formulas within Excel.
We start from defining all the input range, without the first 2 columns and the headers row as a range named input. This is done by selecting all the range and typing "input" in the "Name box":
Create the following table where you like in the workbook, then define it all and a range named col_index:
STRINGVALUE INTEGERVALUE FLOATVALUE FLOATVALUEWITHUNITS BOOLVALUE TIMEVALUE URLVALUE REFERENCEVALUE
NameLegacy ProjectNumber External Coremap OwnerSite Content
OwnerName Periodic Relevance ValidTo
Language
Keywords
This table basically sorts the original columns into their new place. You can add values, rows or columns to the table and it will stay intact, as long as you keep all of it under the name range col_index.
Then create another table headers:
ID Version IBANAME STRINGVALUE INTEGERVALUE FLOATVALUE FLOATVALUEWITHUNITS BOOLVALUE TIMEVALUE URLVALUE REFERENCEVALUE
Now paste the following formulas in the first row in each of column 1-4:
ID: =IF(C2=sheet1!$C$1,A1+1,A1)
Version: =VLOOKUP(A2,sheet1!$A$1:$B$4,2)
after selecting the first 12 rows under IBANAME, press F2, and paste: =TRANSPOSE(sheet1!C1:N1) as array formula! (press ctrl+shift+enter after pasting to the formula box)
STRINGVALUE: =IF(ISERROR(MATCH($C16,OFFSET(col_index,0,MATCH(D$15,OFFSET(col_index,0,0,1,11),0)-1,5,1),0)-1),"",OFFSET(input,TRUNC((ROW()-ROW($D$16))/COLUMNS(input)),MOD(ROW()-ROW($D$16),COLUMNS(input)),1,1))
Next, drag columns ID and Version 12 rows down, to the next ID (row 14), then change the value in cell A2 to 1, and the value in C14 to =C2, and continue dragging columns ID, Version and IBANAME until the end of the data is reached. Finally, drag the cell D2 left to the end of the row, and then down to fill all the table.
This it how it looks with formulas:
And this is with values:
That's it ;)
Related
I have two excel tables, Table A has 4 columns, Table B has 13. Each of the 4 columns in Table A can be found in Table B. They are composed of count data from censuses. During the censuses, people counted the species they encountered and gave a value but they did not write down when they did not encounter a species. I added in 0's for years and locations where species were not found using pivot charts/macros. But now I have my Table A that includes the 0 values but it's missing all the extra data from Table B. The tables look something like this (simplified):
Table A
species location year value
Mango A 2001 2
Mango A 2002 3
Mango A 2003 1
Avocado A 2001 1
Avocado A 2002 0
Avocado A 2003 0
Mango B 2001 0
Mango B 2002 2
Mango B 2003 20
Avocado B 2001 25
Avocado B 2002 80
Avocado B 2003 0
Table B
species location year value month day group uploaded?
Mango A 2001 2 12 1 X No
Mango A 2002 3 12 5 X Yes
Mango A 2003 1 12 3 X No
Avocado A 2001 1 12 1 X No
Mango B 2002 2 12 6 Y No
Mango B 2003 20 12 7 Y No
Avocado B 2001 25 12 4 Y No
Avocado B 2002 80 12 6 Y No
You can see that Table B contains all the rows in Table A that have values above 0 but does not contain the rows with values of 0. Every year/location combo in Table B has the same data for every other column other than species and value.
Is there a way to take the data from Table B and put it into the appropriate rows in Table A? I would like it to work so that every location/year combo in Table B will be transported into every row (including the rows with 0) in Table A. I thought maybe I could do something with relationships but I couldn't figure it out.
Any help is appreciated. Thank you!
Additional Columns
This solution requires the addresses of the ranges containing data, the two column numbers of the ranges to be compared and the number of columns to be added i.e. the number of the last columns from Range1 to be added to Range2.
Before
After
The Code
Sub AdditionalColumns()
Const cStr1 As String = "A4:D15" ' First Range
Const cStr2 As String = "A21:H28" ' Second Range
Const cIntCol1 As Integer = 2 ' First Compare Column
Const cIntCol2 As Integer = 3 ' Second Compare Column
Const cIntAdd As Integer = 4 ' Additional Columns
Dim vnt1 As Variant ' First Array
Dim vnt2 As Variant ' Second Array
Dim vntTarget As Variant ' Target Array
Dim i As Long ' First Array Row Counter
Dim j As Long ' Second Array Row Counter
Dim k As Long ' Target Array Column Counter
With ThisWorkbook.Worksheets("Sheet1")
vnt1 = .Range(cStr1)
vnt2 = .Range(cStr2)
ReDim vntTarget(1 To UBound(vnt1), 1 To cIntAdd)
For i = 1 To UBound(vnt1)
For j = 1 To UBound(vnt2)
If vnt1(i, cIntCol1) = vnt2(j, cIntCol1) Then
If vnt1(i, cIntCol2) = vnt2(j, cIntCol2) Then
For k = 1 To cIntAdd
vntTarget(i, k) = vnt2(j, k + UBound(vnt1, 2))
Next
Exit For
End If
End If
Next
Next
.Cells(.Range(cStr1).Row, .Range(cStr1).Columns.Count _
+ .Range(cStr1).Column) _
.Resize(UBound(vntTarget), UBound(vntTarget, 2)) = vntTarget
End With
End Sub
I need a macro or formula that can do this:
Column A Values:
1
1
1
2
2
2
3
3
4
4
4
5
5
6
6
I need Column B to do:
1
2
3
1
2
3
1
2
1
2
3
1
2
1
2
Because column B has to have an increment number while column A has the same repeated value (for example 1 1 1 2), when it changes (to 2 or 3 etc.) the counter on column B has to reset and increment itself while A repeats the next value (1 2 3 1)
Thanks
Edit
Have a look at bzimor's answer as he solves is in a more general way without a hard value in column B1!
Original Answer
You can solve it the following way without VBA:
Put a hard value of 1 in column B1. This is your start value and should be always correct because you start counting with 1.
Then enter the following formula in B2
=IF($A2=$A1;$B1+1;1)
Just drag the formula down to the other rows of B and you're done
So B3 should look like this
=IF($A3=$A2;$B2+1;1)
and so on ...
You can use single formula:
=COUNTIF($A$1:A1,A1)
Put it into cell B1 and fill down
Here is your desired macros
Sub jkjainGenerateSerialNumber20161124()
readcol = Val(InputBox("type ref col#"))
writecol = Val(InputBox("type dest col#"))
ts = 0
Range("A1000000").Select
Selection.End(xlUp).Select
lastrow = ActiveCell.Row
For n = 2 To lastrow
prev = Cells(n - 1, readcol)
curr = Cells(n, readcol)
If prev <> curr Then
ts = 1
End If
If prev = curr Then
ts = ts + 1
End If
Cells(n, writecol) = ts
Next
End Sub
I am stuck, and would like a little hlep. I'm trying to get a qty on Column D12, d14, d16 .... to d42. Than multiply this qty by a value. the value sheet look like this.
Value Sheet
A B C
ItemName Quality Confort
1 Chair 2 1
2 Bed 0 3
3 Table 1 1
Quantity Sheet
A B C D
ItemName QTYColumn
12 .. Table 2
13
14 .. Chair 5
15
16 .. Bed 6
Total Sheet
A B
Quality 12 (2*1 + 5*2 + 6*0 )
Confort 25 (2*1 + 5*1 + 6*3 )
I'm pretty sur I have the hardest part done. I can check and grab the quantity from all the sheets I want. I also got a function done where you pass the name of the item, and the stats name, and it return me the results I want.
so, I got this part of the code atm which doesnt work, and its driving me nuts.
For Counter = 12 To 42 Step 2
For Each qColumn In QTYColumn
Set QTY = Range(qColumn & Counter)
Dim ItemName As Range
ItemName= QTY.Offset(-2, 0).Select
total = total + (QTY * GetValue(ItemName, "Confort"))
Next qColumn
Next Counter
My problem is with the ItemName variable. Its always empty and as soon as I get to it with the debugger, the function stops and it closes. Anyone have any idea as to why ? it's important for me to get it base on the offset -2 and not the column adress because it might be different depending of the sheet, and the only "sure" way to find it is the get the 2nd cell to the left of the quantity cell.
ItemName= QTY.Offset(-2, 0).Select does not mean anything !
Either you Select:
QTY.Offset(-2, 0).Select
or you get the value:
ItemName= QTY.Offset(-2, 0).Value '(value can be omitted here)
But then, Dim ItemName As Range does not make sense. It should be a String or a a number.
or you get the range:
Set ItemName= QTY.Offset(-2, 0) ' then you need Set
I'm trying to build a macro in excel that will take a bunch of data like this:
D 1 2 3 4 5
D 1 2 3 9 5
D 1 2 3 4 5
And process it to insert a row when a value in column 4 differs. I also want to populate this row at the same time with either static values or a formula.
So ideally, taking the above table I would get:
D 1 2 3 4 5
H A B C D E <- This row got added as there was a change in column D
D 1 2 3 9 5
H A B C D E <- This row got added as there was a change in column D
D 1 2 3 4 5
I would want this to iterate through a quite long list.
Can anyone give me any pointers?
Thank you for your help.
Something like this should work. I didn't test it but if you run it and use F8 to iterate through it should be easy to debug if it doesn't work exactly as intended.
Dim i as integer
for i = 2 to cells(1,1).end(xldown).row 'itereate thru all rows
if cells(i,4).value <> cells(i-1,4).value then 'compare the cells in col 4 with previous row
rows(i).entirerow.insert 'insert a row if the values don't match
cells(i,1) = "A"
cells(i,2) = "B"
cells(i,3) = "C"
cells(i,4) = "D"
cells(i,5) = "E"
i = i + 1 'since we inserted a row we have to make i bigger to go down
end if
next i
I am trying to highlight expiry dates in Excel VBA. I need Column B to Highlight dates that will expire within the next month and Column c to highlight dates that will expire within 4 - 6 months. At present the code works if I delete columns and run the code on one column at a time e.g.
Name Green Will Expire within 1 Month
Name 1 01/01/2013
Name 2 17/07/2013
Name 3 03/04/2013
Name 4 24/03/2013
Name 5 16/07/2013
Name 6 26/01/2013
Name 7 28/06/2013
Name 8 01/07/2013
Name 9 09/01/2013
Name 10 31/07/2013
Name (Column A), Green Will Expire within 1 Month (Column B).
If I run the code with these two columns only (Having deleted Column C) the code works fine. If I include my third column, Orange Expires in 4 - 6 Months (Column C):
Name Green Will Expire within 1 Month Orange Expires in 4 - 6 Months
Name 1 01/01/2013 01/01/2013
Name 2 17/07/2013 01/12/2013
Name 3 03/04/2013 03/04/2013
Name 4 24/03/2013 20/11/2013
Name 5 16/07/2013 16/07/2013
Name 6 26/01/2013 26/01/2013
Name 7 28/06/2013 28/06/2013
Name 8 01/07/2013 01/07/2013
Name 9 09/01/2013 09/01/2013
Name 10 31/07/2013 31/07/2013
Only the second for loop works. I need both of these for loops to run without having to delete any columns.
VBA Code:
Private Sub CommandButton1_Click()
Dim Cell As Range
For Each Cell In Range("B2:B1000").Cells
If Cell.Value <= Date + 30 And Not (Cell.Value < Date) And IsEmpty(Cell.Offset(0, 1).Value) Then
Cell.Interior.ColorIndex = 35
End If
Next Cell
For Each Cell In Range("C2:C1000").Cells
If Cell.Value <= Date + 180 And Not (Cell.Value <= Date + 120) And IsEmpty(Cell.Offset(0, 1).Value) Then
Cell.Interior.ColorIndex = 45
End If
Next Cell
End Sub
Any Help is greatly appreciated.
Thank You
The part of your conditional statement will always evaluate to False if Column C is not empty:
And IsEmpty(Cell.Offset(0, 1).Value)
On a related note, the same fragment is in the second loop, so you may want to remove it from there, too. But I am not sure if that part would be required logic. In any case, the same holds: If column D is not empty, this will always evaluate to false, so the body of the If...Then will be omitted.