I have a data set in which there is an id field and a number of other fields.
The id field at times has a second id. In this case, I need to create a new duplicated record and put a single id in each of the records. There is an additional condition in which each of the ids may be followed by a number which is a percentage. In all cases, I need to display the correct percentage as a decimal value in a field on the record.
id examples:
AJ01-25/ST01-75
AJ01/LM03
RICH01
Correct representation of ids and percentages:
id percent
AJ01 .25
ST01 .75
AJ01 .5
LM03 .5
RICH01 1.0
I used the following code to create a new record and parse any percentages into a new field whenever a "/" is detected, but I'd very much like to have something cleaner. Sort order does not matter (my script places new records at the end). Thoughts?
Sub breakemup()
Dim wb As Workbook
Dim ws As Worksheet
Dim id As String
Dim rng As Range
Dim ar() As String
Set wb = ThisWorkbook
Set ws = wb.Worksheets("data")
Dim currentRow As Integer
Dim finalRow As Integer
finalRow = ws.UsedRange.Rows.Count
For currentRow = 2 To finalRow
ar() = Split(ws.Range("a" & currentRow).Value, "/")
If UBound(ar) = 1 Then
ws.Rows(currentRow).Copy Destination:=ws.Range("A" & Rows.Count).End(xlUp).Offset(1)
If UBound(Split(ar(1), "-")) = 1 Then
ws.Range("A" & Rows.Count).End(xlUp).Value = Split(ar(1), "-")(0)
ws.Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = CDbl(Split(ar(1), "-")(1)) / 100#
ws.Range("A" & currentRow).Value = Split(ar(0), "-")(0)
ws.Range("A" & currentRow).Offset(0, 1).Value = CDbl(Split(ar(0), "-")(1)) / 100#
Else
ws.Range("A" & Rows.Count).End(xlUp).Value = ar(1)
ws.Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = 50 / 100#
ws.Range("A" & currentRow).Value = ar(0)
ws.Range("A" & currentRow).Offset(0, 1).Value = 50 / 100#
End If
Else
ws.Range("A" & currentRow).Offset(0, 1).Value = 1#
End If
Next
End Sub
Not sure if you would consider this cleaner but here is a formula solution rather than a VBA one. It uses the functions:
INDIRECT
MID
LEN
IF
RIGHT
FIND
Lets say we have the following in sheet 1:
Insert the following formulas in sheet 2:
Cell A2:
=IF(E2=1, IF(D2="", IF(C2="", INDIRECT(G2), LEFT(INDIRECT(G2), C2-1)), LEFT(INDIRECT(G2), D2-1)), IF(D2="",IF(C1="", INDIRECT(G2), RIGHT(INDIRECT(G2), LEN(INDIRECT(G2))-C1)), MID(INDIRECT(G2), C1+1, D2 -1-C1)))
Drag / Copy it down to cover the rest of the cells in column A
Cell B2:
=IF(E2=1,IF(C2="",IF(D2="",1,MID(INDIRECT(G2),C2+1,LEN(INDIRECT(G2)))),IF(D2="",0.5,MID(INDIRECT(G2),D2+1,C2-D2-1)/100)), IF(D2="",0.5,MID(INDIRECT(G2),D2+1, LEN(INDIRECT(G2))-D2)/100))
Drag / Copy it down to cover the rest of the cells in column B
Cell C2:
=IF(E2=1, IF(ISNUMBER(FIND("/",INDIRECT(G2))),FIND("/", INDIRECT(G2)), ""), "")
Drag / Copy it down to cover the rest of the cells in column C
Cell D2:
=IF(E2=1, IF(ISNUMBER(FIND("-", INDIRECT(G2))),FIND("-", INDIRECT(G2)), ""),IF(D1 ="", "", FIND("-", INDIRECT(G2), D1+1)))
Drag / Copy it down to cover the rest of the cells in column D
Cell E2:
The number value "1"
Cell E3:
=IF(E2=1, IF(C2="", 1, 2),1)
Drag / Copy it down to cover the rest of the cells in column E
Cell F2:
the number value "1"
Cell F3:
=IF(E3=1, F2+1, F2)
Drag / Copy it down to cover the rest of the cells in column F
Cell G2:
="Sheet1!A" & TEXT(F2, 0)
Drag / Copy it down to cover the rest of the cells in column G
Result:
You could hide the extra columns so you only see the columns you need:
I have an article on my blog that provides an example with pretty much the same functions used here, it might help with understanding the functions used Excel Functions and Formulas Sample #1, Split Strings Based on Delimeter
Related
I am trying to make VBA write a formula into different cells that will find the maximum value for a Range decided by some variables. My variables I and J are (numbers/Integers).
Here is my code.
Sub AddMAX()
Dim I As Integer
Dim J As Integer
Dim L As Integer
I = InputBox("Number of columns to check max value")
J = InputBox("Number of Rows to add formula inn and find max value of that row")
For L = 5 To 4 + J
Worksheets(1).Cells(L, 4 + I).Formula = "=" & Max(Range(Cells(L, 4), Cells(L, 3 + I)))
Next L
End Sub
Have tried to re-write the second part (part behind the equal sign) several times. Usually I get the message Compile error: Sub or Function not defined and it marks the "Max". I thought Max (also tried with big letters) was an in-built function like SUM and so on.
I'm trying to make it write an Excel formula like this into the cells:
For I=2 and J=3:
Cell F5: =MAX(D5:E5)
Cell F6: =MAX(D6:E6)
Cell F7: =MAX(D7:E7)
i.e. I want a formula in the cells like I had wrote it in the cells manually to calculate max value, so that if the value in Cells D5, to D7 and E5 to E7 change, the new max value will be found without any scripts having to run.
Let me know if something is unclear.
You should not be putting Range and Cells in a formula string, they mean nothing to the Excel formula engine. You need the Address of the cells:
Dim I As Long
Dim J As Long
Dim L As Long
I = InputBox("Number of columns to check max value")
J = InputBox("Number of Rows to add formula inn and find max value of that row")
L = 5
With Worksheets(1)
.Range(.Cells(L, 4 + I), .Cells(4 + J, 4 + I)).Formula = "=MAX(" & .Cells(L, 4).Address(False, False) & ":" & .Cells(L, I + 3).Address(False, False) & ")"
End With
The formula is actually the same for all cells, which is why it is possible to assign it in one assignment for the entire range. It looks different in the A1 reference notation, but if you switch to R1C1 in the Excel settings, you will see they are the same. Which also means it is easier to create that formula using the R1C1 notation in the first place:
Dim I As Long
Dim J As Long
Dim L As Long
I = InputBox("Number of columns to check max value")
J = InputBox("Number of Rows to add formula inn and find max value of that row")
L = 5
With Worksheets(1)
.Range(.Cells(L, 4 + I), .Cells(4 + J, 4 + I)).FormulaR1C1 = "=MAX(RC[-" & I & "]:RC[-1])"
End With
But it would appear to me that you should instead use the Excel interface the intended way. Select the cells in which the MAX formula should be. Keeping the entire range selected, put the MAX formula into any of its cells as if you were creating it for just that cell, but instead of pressing Enter, press Ctrl+Enter.
You have to be careful to distinct between the part that is seen by VBA and the final formula.
If you write
Worksheets(1).Cells(L, 4 + I).Formula = "=" & Max(Range(Cells(L, 4), Cells(L, 3 + I)))
Max (and all the following stuff) is seen by the VBA-interpreter, not Excel. But there is no Max-function, and you get an (compiler)-error.
If you write
Worksheets(1).Cells(L, 4 + I).Formula = "=Max(Range(Cells(L, 4), Cells(L, 3 + I)))"
the VBA-interpreter sees the whole stuff as a string. It cannot take care about variables like L or I because is doesn't see them. So you end up with a formula that is exactly like you write it - and Excel (not VBA) will show you an error because it doesn't understand L or I.
What you need is a statement (in VBA) that creates a string that contains the actual values of your variables, and assign it to the cell.formula. I strongly advice that you first assign this to a string variable - it makes debugging much easier:
Dim formula As String
formula = "=Max(Range(Cells(" & L & ", 4), Cells(" & L & ", 3 + " & I & ")))"
Debug.Print formula
Worksheets(1).Cells(L, 4 + I).Formula = formula
Update: Sorry, I haven't looked to the content of the formula at all, of course the Range and Cells-objects are VBA objects. What you need in your formula is the address of the range, so change the line to
formula = "=MAX(" & Range(Cells(L, 4), Cells(L, 3 + i)).Address & ")"
Now VBA will create a Range and put the address into the formula string.
I need a code in VBA which is equivalent to match inside a vlookup in Excel.
Have got 2 sheets one MasterSheet and another required_data_sheet.
There are 18 columns in MasterSheet and in required_data_sheet there are only 11 out of 18 columns of MasterSheet (not all of these 11 columns are in same order as first 11 columns in MasterSheet). The first column in both sheets is item_id which is the primary key. MasterSheet has 45000 records and Required_data_sheet has only few hundreds rows with only 1st column (which is item ID) populated and for these few hundred other 10 (11-1st column) needs to be populated.
I can use below formula in required_data_sheet to get data from mastersheet, which gives correct result. I only write this formula in cell A2 of required_data_sheet and then copy the same in all cells.
=VLOOKUP($A2,Master,MATCH(B$1,Master[#Headers],0),FALSE)
Master is the table name of data in MasterSheet.
Problem is I am unable to write the correct VBA code for this. Code is problematic in the Match formula part.
Below is my code and Match formula is preventing it from giving the desired result.
Sub Fetch_Specific_Columns()
Dim lastrow As Long
Dim lastcolumn As Integer
Dim c As Integer
Dim r As Long
lastrow = Range("A" & Rows.Count).End(xlUp).row
lastcolumn = Range("A1").End(xlToRight).Column
For c = 2 To lastcolumn
For r = 2 To lastrow
Worksheets("Required_Data_Sheet").Cells(r, c).Formula = "=VLOOKUP(A" & r & ",Master,MATCH(" & Worksheets("Required_Data_Sheet").Cells(1, c) & ",'Master Sheet'!$A$1:$R$1,0),FALSE)"
Next r
Next c
End Sub
Expected result is somehow match formula works in the desired fashion.
The problem with your code is this portion:
MATCH(" & Worksheets("Required_Data_Sheet").Cells(1, c) & ",
It is inserting the value from cell(1,c) directly into the formula without quotes. This is incorrect excel formula syntax. Instead you should either:
Insert a cell reference (e.g. B3) or
The value of the cell in quotation marks.
Here is the whole line with the correction for method 1:
Worksheets("Required_Data_Sheet").Cells(r, c).Formula = "=VLOOKUP(A" & r & ",Master,MATCH(" & Worksheets("Required_Data_Sheet").Cells(1, c).Address & ",'Master Sheet'!$A$1:$R$1,0),FALSE)"
Here is the whole line with the correction for method 2:
Worksheets("Required_Data_Sheet").Cells(r, c).Formula = "=VLOOKUP(A" & r & ",Master,MATCH(""" & Worksheets("Required_Data_Sheet").Cells(1, c) & """,'Master Sheet'!$A$1:$R$1,0),FALSE)"
I've just created a brand new macro. Took function down below from internet (all credits goes to trumpexcel.com), code down below
Function CONCATENATEMULTIPLE(Ref As Range, Separator As String) As String
Dim Cell As Range
Dim Result As String
For Each Cell In Ref
Result = Result & Cell.Value & Separator
Next Cell
CONCATENATEMULTIPLE = Left(Result, Len(Result) - 1)
End Function
Then I proceed to extract data from various columns and into the one (my table is 20 rows x 10 columns)
Sub conact_data()
Dim i As Integer
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(i, "M").Value = Cells(i, "A").Value & " " & _
Cells(i, "B").Value & " / " & Cells(i, "D").Value & "; "
Next i
End Sub
Thanks to that I've got combined data from column A, B and D, so its 20 rows. All I want to do now is to concatenate data from M2:M21 using CONCATENATEMULTIPLE function therefore I try various approach (I want this huge line in P2 cell) like :
Cells(2, 16).Value = CONCATENATEMULTIPLE (M2:M21, " ")
or
Range("P2") = "CONCATENATEMULTIPLE (M2:M21, " ")"
I don't really know how to apply that
Secondly, I'd like withdraw the Cells(i, "B").Value as percentage. Can I do that in one line like Cells(i, "B").NumberFormat="0.00%".Value (which is not working for me obviously) else I need to copy column B into another column with number format and then combine the new column, properly formatted instead of column B?
Thanks in advance
Percent format: Range("B" & i).NumberFormat = "0.00%"
CONCATENATEMULTIPLE
In VBA, CHR(32) = " "
In Excel, CHAR(32) = " "
With that being said...
'Value
Range("P2").Value = CONCATENATEMULTIPLE(Range("M2:M21"), CHR(32))
'Formula
Range("P2").Formula = "=CONCATENATEMULTIPLE(M2:M21, CHAR(32))"
You should really qualify all of your ranges with a worksheet
Say your workbook has 10 sheets. When you say Range("P2"), how do we (VBE) know what sheet you mean? Objects need to be properly qualified. Sometimes this is not a huge issue, but when you are working across multiple sheets, not qualifying ranges can lead to some unexpected results.
You can qualify with a worksheet a few ways.
Directly: ThisWorkbook.Sheets("Sheet1").Range("P2").Copy
Or use a variable like so
Dim ws as Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
ws.Range("P2").Copy
Now there is no room for ambiguity (potential errors) as to the exact location of Range("P2")
First of all, remove your ConcatenateMultiple() code, and instead use Excel worksheet function CONCAT(), which takes a range and a delimiter as parameters.
Here is how you can handle the percentage issue and supply a default for non-numeric items. I've also cleaned up the way you reference your data range.
Sub concat_data()
Dim rngRow As Range, vResult As Variant
Const DEFAULT = 0 'Can also be set to a text value, eg. "Missing"
For Each rngRow In [A2].CurrentRegion.Rows
If IsNumeric(rngRow.Cells(, 4)) Then vResult = rngRow.Cells(, 4) * 100 & "%" Else vResult = DEFAULT
Range("M" & rngRow.Row) = rngRow.Cells(, 1) & rngRow.Cells(, 2) & "/" & vResult & ";"
Next
[M2].End(xlDown).Offset(1).Formula = "=CONCAT(M2:M" & [M2].End(xlDown).Row & ",TRUE,"" "")"
End Sub
I'm not a fan of hard-coding range references, like the [A2] or Range("M"), but will leave that for another time.
I am trying to insert the following formula ='External Costs B0'!F73 in the same row of a sheet in consecutive columns, however with the cell reference "F73" in worksheet "External Costs" referring to alternate columns e.g F73, H73, J73, L73 etc.
Here is a screen shot of the spreadsheet with formula commented
Screen Capture of formula sheet
This is the code I have tried but I am struggling to figure how to get the alternative column reference working.
Dim CostColumns As Long
'Select cell to start inserting the formula from
Range("E26").Select
'Start from column F (6) in the "External Costs B0" sheet and step to every alternate column
For CostColumns = 6 To 600 Step 2
ActiveCell.Formula = "= ""'External Costs B0'!"" & Rows(73)Columns(CostColumns)"
Move to the next cell to insert the formula in and advance the column reference by 2 columns
ActiveCell.Offset(0, 1).Select
Next CostColumns
The net result is the same error I have seen in many posts:
Application-defined or object-defined error.
Here are many other syntax's for the formula insert I have tried with no success. Any help is greatly appreciated. The below refers to row 40 instead of row 73 in the External Costs B0 sheet as per the example above.
Range("E26").Select
For CostColumns = 6 To 66 Step 2
'ActiveCell.FormulaR1C1 = "= worksheets("""External Costs B0""").Cells(40,6).Value"
'ActiveCell.FormulaR1C1 = "='External Costs B0'!R[14]C[CostColumns]"
'Range("E26:AK26").FormulaR1C1 = "='External Costs B0'!R[14]C[CostColumns]"
'ActiveCell.FormulaR1C1 = "= worksheets('External Costs B0')!" & " Rows(40)Columns(CostColumns)"
'Range("E26:AK26").FormulaR1C1 = "='External Costs B0'!R[14]C[+2]"
'Range("E26:AK26").FormulaR1C1 = "=Wksht.Cells(40,CostColumns) &"
'Range("E26:AK26").Formula = "=worksheets('External Costs B0'!)" & ".Cells(40,6)"
'ActiveCell.Formula = "= worksheets('External Costs B0'!).Cells(40,6).Value"
ActiveCell.Offset(0, 1).Select
Next CostColumns
Use this:
ActiveCell.Formula = "='External Costs B0'!" & Cells(73, CostColumns).Address(0, 0)
The problem with that is that Rows(73) and Columns(CostColumns) both return a Range object which you can't concatenate to a string.
Its way easier, if you use FormulaR1C1 and no selects like in the following sub:
(please change R, RowOffset and FormulaUntilColumn to your needs)
Sub Formulas()
Dim I As Integer
Const R As Long = 9 'row
Const RowOffset As Integer = -8
Const ForumulaUntilColumn As Long = 7
For I = 1 To ForumulaUntilColumn
Cells(R, I).FormulaR1C1 = "=R[" & RowOffset & "]C[" & I - 1 & "]"
Next I
End Sub
P.S.: add workbook and table name as in any other formula between '=' and 'R['
This code will place your formula in cells Sheet1!A1:AD1.
The formula in A1 will be ='External Costs B0'!$A$73.
In B1 it will be ='External Costs B0'!$C$73 and so on up to ='External Costs B0'!$BG$73 in cell AD1.
Sub PasteFormula()
Dim CostColumns As Long
Dim y As Long
'Starting column for External Costs reference
CostColumns = 1
With ThisWorkbook.Worksheets("Sheet1")
For y = 1 To 30
.Cells(1, y).FormulaR1C1 = "='External Costs B0'!R73C" & CostColumns
CostColumns = CostColumns + 2
Next y
End With
End Sub
To update the code change Sheet1 to whichever sheet you need to
formula to appear in.
Change CostColumn=1 to the correct column
number you want the formula to refer to.
Change y = 1 To 30 to
the correct columns you want the formula to appear in.
The code uses R1C1 syntax as it's easier to update a formula if you only need to deal with row & column numbers R73C2 is row 73, column 2 for example.
Good afternoon all,
I have an issue where I have users who have multiple bank account details. I need to try and create a new row for each employee who has more than one bank account, with the second bank account being allocated a new row.
Employee Number User ID BSB Account number
10000591 WOODSP0 306089,116879 343509,041145273
10000592 THOMSOS0 037125 317166
I need it to look something like this:
Employee Number User ID BSB Account number
10000591 WOODSP0 306089 343509
10000591 WOODSP0 116879 041145273
10000592 THOMSOS0 037125 317166
Any thoughts? Your input is greatly appreciated!
Screenshots are here to demonstrate:
Right click on the tab and choose "View Code"
Paste this code in:
Sub SplitOnAccount()
Dim X As Long, Y As Long, EmpNo As String, UserID As String, BSB As Variant, AccNo As Variant
Range("F1:I1") = Application.Transpose(Application.Transpose(Array(Range("A1:D1"))))
For X = 2 To Range("A" & Rows.Count).End(xlUp).Row
EmpNo = Range("A" & X).Text
UserID = Range("B" & X).Text
BSB = Split(Range("C" & X).Text, ",")
AccNo = Split(Range("D" & X).Text, ",")
For Y = LBound(AccNo) To UBound(AccNo)
Range("F" & Range("F" & Rows.Count).End(xlUp).Row).Offset(1, 0).Formula = EmpNo
Range("G" & Range("G" & Rows.Count).End(xlUp).Row).Offset(1, 0).Formula = UserID
Range("H" & Range("H" & Rows.Count).End(xlUp).Row).Offset(1, 0).Formula = BSB(Y)
Range("I" & Range("I" & Rows.Count).End(xlUp).Row).Offset(1, 0).Formula = AccNo(Y)
Next
Next
End Sub
Close the window to go back to excel
Press ALT-F8
Choose SplitOnAccount and click run.
Note, this is going to populate the split data to rows F to I, make sure there is nothing in there. If there is post back and we can change it.
Also format columns F - I as text before you run it or Excel will strip leading zeros off as it will interpret it as a number.
Here is another sub that appears to perform what you are looking for.
Sub stack_accounts()
Dim rw As Long, b As Long
Dim vVALs As Variant, vBSBs As Variant, vACTs As Variant
With ActiveSheet '<-define this worksheet properly!
For rw = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
vVALs = .Cells(rw, 1).Resize(1, 4).Value
vBSBs = Split(vVALs(1, 3), Chr(44))
vACTs = Split(vVALs(1, 4), Chr(44))
If UBound(vBSBs) = UBound(vBSBs) Then
For b = UBound(vBSBs) To LBound(vBSBs) Step -1
If b > LBound(vBSBs) Then _
.Rows(rw + 1).Insert
.Cells(rw - (b > LBound(vBSBs)), 1).Resize(1, 4) = vVALs
.Cells(rw - (b > LBound(vBSBs)), 3).Resize(1, 2).NumberFormat = "#"
.Cells(rw - (b > LBound(vBSBs)), 3) = CStr(vBSBs(b))
.Cells(rw - (b > LBound(vBSBs)), 4) = CStr(vACTs(b))
Next b
End If
Next rw
End With
End Sub
I was originally only going to process the rows that had comma delimited values in columns C and D but I thought that processing all of them would allow the macro to set the Text number format and get rid of the Number as text error warnings and keep the leading zero in 041145273.
You Can definitely use Power Query to transform the data to generate new rows using split column option.
Check this article it explains the process in detail.
Load Data in Power Query section of excel.
Create an Index (Not required step)
Use Split column function with advance options and split them into new rows.
Save this result into new table for your use.
I did it myself and it worked like a charm.
A formula solution:
Delimiter: Can be a real delimiter or an absolute reference to a cell containing only the delimiter.
HelperCol: I have to use a helper column to make it work. You need to give the column letter.
StartCol: The column letter of the first column containing data.
SplitCol: The column letter of the column to be splitted.
Formula1: Used to generate the formula for the first column not to be splitted. You can fill this formula down and then fill to right.
Formula2: Used to generate the formula for the column to be splitted(only support split one column).
Formula3: Used to generate the formula for the Helper column.
(If the title of the column to be splitted contains the delimiter, you must change the first value of the helper column to 1 manually.)
Formula1:=SUBSTITUTE(SUBSTITUTE("=LOOKUP(ROW(1:1),$J:$J,A:A)&""""","$J:$J","$"&B2&":$"&B2),"A:A",B3&":"&B3)
Formula2:=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE("=MID($M$1&LOOKUP(ROW(A1),$J:$J,F:F)&$M$1,FIND(""艹"",SUBSTITUTE($M$1&LOOKUP(ROW(A1),$J:$J,F:F)&$M$1,$M$1,"&"""艹"",ROW(A2)-LOOKUP(ROW(A1),$J:$J)))+1,FIND(""艹"",SUBSTITUTE($M$1&LOOKUP(ROW(A1),$J:$J,F:F)&$M$1,$M$1,""艹"",ROW(A2)-LOOKUP(ROW(A1),$J:$J)+1))-FIND(""艹"",SUBSTITUTE($M$1&LOOKUP(ROW(A1),$J:$J,F:F)&$M$1,$M$1,""艹"",ROW(A2)-LOOKUP(ROW(A1),$J:$J)))-1)&""""","$M$1",IF(ISERROR(INDIRECT(B1)),""""&B1&"""",B1)),"$J:$J","$"&B2&":$"&B2),"F:F",B4&":"&B4)
Formula3:=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE("=SUM(E1,LEN(B1)-LEN(SUBSTITUTE(B1,$H$1,"""")))+1","B1",B4&1),"$H$1",IF(ISERROR(INDIRECT(B1)),""""&B1&"""",B1)),"E1",B2&1)
Helper must filled one row more than the data.
How to use:
Copy the formula generated by the above three formula.
Use Paste Special only paste the value.
Make the formula into effect.
Fill the formula.
Bug:
Numbers will be converted to Text. Of course you can remove the &"" at the end of the formula, but blank cells will be filled with 0.
ps. This method may by very hard to comprehend. But once you master it, it can be very useful to solve relative problems.