In Excel VBA, extract range text and sum data - excel

I have a spreadsheet in which there are multiple rows that have three columns (K, L M) that contain text (inserted manually from a dropdown). The inserted text includes a 'score'. For the row shown in the image that score is 3 + 2 + 2 = 7.
What I'd like to be able to do is to have that score automatically calculated and shown in column N. I'm happy to do the score extraction given the text, but I'm completey unfamiliar with Excel's object model, and how to write a VBA macro that can be triggered across all of the rows. I assume it would be passed a range somehow, or a string designating a range, but how to do that is beyond me just now. Perhaps I just need a formula? But one that calls a function to strip non-numerical data from the cell?
Any help appreciated.

Put this formula in N2 cell and drag it all the way down.
=LEFT(K2, FIND("-", K2) - 2) + LEFT(L2, FIND("-", L2) - 2) + LEFT(M2, FIND("-", M2) - 2)
For more information see reference. It sum all numbers, that are present before the hyphen (-) in a cell.

Try:
N2 = LEFT(TRIM(K2),1) + LEFT(TRIM(L2),1) + LEFT(TRIM(M2),1)
As I said in comments, this solution does not scale so well if it is more than three columns and / or the scores are more than single digit [0-9]

A VBA solution to do all of your rows and enter the values into Column N:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "K").End(xlUp).Row
'get the last row with data on Column A
For rownumber = 1 To LastRow 'loop through rows
For i = 11 To 13 'loop through columns
strValue = ws.Cells(rownumber, i).Value 'get text string from cell
pos = InStr(strValue, " -") 'find the dash - in cell
If pos > 0 Then 'if dash found
Value = Value + Val(Left(ws.Cells(rownumber, i).Value, pos - 1)) 'remove everything after number
End If
Next i
ws.Cells(rownumber, 14).Value = Value 'write value to column N
Value = 0
Next rownumber
End Sub

Related

Matching the data across column and rows using VBA

I have two sheets :
Sheet 1 consist of :
Sheet 2 consist of :
And the output should show in M column in Sheet1. I am attaching the sample output here :
So,what I have here is ID in Sheet 1, for eg : ID 'US' has Abhay,Carl and Dev
and in Sheet3, I have names in column and ID in Rows.
What i want is my Sample output column should populate using macro based on matched values from Sheet3
I am using below logic but something is going wrong :
For i = 2 To 10
j = i + 1
If ThisWorkbook.Sheets("Input").Range("N" & i) = ThisWorkbook.Sheets("Sheet3").Range("A" & i) And ThisWorkbook.Sheets("Input").Range("K" & i) = ThisWorkbook.Sheets("Sheet3").Range("B1") Then
ThisWorkbook.Sheets("Input").Range("O" & i) = ThisWorkbook.Sheets("Sheet3").Range("B" & j)
End If
Next i
Since you asked for a VBA solution, please see the code below.
Dim colLen As Integer
Dim i As Integer
Dim colPt As Integer
Dim rowPt As Integer
' Counts number of rows on Sheet 1, column B.
colLen = Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row
' Loops through all names on Sheet 1.
For i = 2 To colLen
' Retain US or NA ID for blank cells.
If Sheets(1).Cells(i, 1) <> "" Then
If Sheets(1).Cells(i, 1) = "US" Then
colPt = 2
Else
colPt = 3
End If
End If
' Find name on Sheet 2 and set row.
rowPt = Sheets(2).Range("A:A").Find(Sheets(1).Cells(i, 2)).Row
' Add ID from Sheet 2 to Sheet 3
Sheets(1).Cells(i, 3) = Sheets(2).Cells(rowPt, colPt)
Next i
Assumptions:
Sheet 1 is the main worksheet, sheet 2 has the lookup data.
All names in the lookup data are unique.
I would recommend including the ID in every row instead of treating it as a heading but that's preference. There are formula solutions that would work for this as well if you want to skip VBA.
There are a few ways to approach this. Below is one of them:
NOTE: for simplicity, I have kept my data on one sheet. You can amend the below formulas as your data is on 2 sheets. Saying that, I have used the same columns as you have in your query
Solution:
Have a "holding column". In my example, I used column J as the holding column (you can hide this column if you want). In J2, type the following formula: =IF(ISBLANK($K2), $J1,$K2). Copy the formula down to all used rows. Then copy the following formula in M2: =VLOOKUP($L2,$A$3:$C$8,IF($J2="US",2,3),FALSE). As per before, copy the formula down to all used rows. This should give you your results

Extract and Copy text between characters in excel

I am looking for a way to extract text between 2 characters and copy them to a column at the end of the spreadsheet.
For example, my text looks like [abcdefg], all in Column A, I am looking to extract the text between the "[" and copy it to a new column at the end of the worksheet (as a new column)
Thanks
I would resort to functions since they're just the easiest. To pull the data between 2 characters, you'd use a mixture of MID and FIND functions.
So, assuming your data was in cell A1, you could put this formula in the cell where you want the parsed value:
=MID(A1,FIND("[",A1)+1,FIND("]",A1)-FIND("[",A1)-1)
If you wanted to automate it, you could put it into a macro then copy / paste-special values to remove the function and keep the values.
This is for text in Cell 1, 1 but you can toss some variables in there as you loop through your rows. It will grab the values within square brackets & trim it, additional text can be in front or behind the brackets.
Dim iPos1 As Integer
Dim iPos2 As Integer
iPos1 = InStr(Sheet1.Cells(1, 1), "[")
iPos2 = InStr(Sheet1.Cells(1, 1), "]")
Sheet1.Cells(1, 2) = Trim(Mid(Sheet1.Cells(1, 1), iPos1 + 1, iPos2 - iPos1 - 1))
If you want to write this into a vba module, looping through all entries in the A column and extracting the text inside the [] into an entry in column B, it might look something like:
Dim ws as Worksheet
Dim i as integer
Dim lastRow as Integer
Dim brack1pos as Integer
Dim brack2pos as Integer
Set ws = ThisWorkbook.Worksheets("My Sheet Name")
for i = 1 to lastRow 'I'll leave to you how to find the last row
brack1pos = InStr(ws.Range("A" & i), "[")
brack2pos = InStr(ws.Range("A" & i), "]")
ws.Range("B" & i) = Trim(Mid(ws.Range("A" & i), brack1pos + 1, brack2pos - brack1pos - 1))
next

Table from Excel to another table

Suppose there are 3 columns. In 1 column number (a1), in the second name (b1), in the third description (c1). I want to make another 1 table, so that the data would spread to it, but with 1 condition. If in the 3 column, in one cell more than 500 characters, then continue to copy the data from the rows to the next cell. (For example, there is a line a2, b2, c2 In cell c2, 600 symbols are obtained, then the remaining characters are transferred to one cell, c3 and copy the text from cells a2, b2) Is it possible to trace it? To make, some counter, that he would count the symbols in the cell.
enter image description here
table
tabletest1
Well, i think this image will be self explanatory
First table contains your original data. Right upper one contains the results, and bottom one contains the formula
The formula =IF((LEN(C2) > 5);MID(C2;6;500);" ") checks the length of the text inside a cell, if its greater than 5 (you can modify this of course), then set the value of the cell to a substring (from 6th character) of the original text.
VB Macro
After some tries, i got a VB macro which makes that
Sub copyTable()
Dim colRange As Variant
colRange = Array(1, 2, 3) 'Columns where your data is'
Dim destColRange As Variant
destColRange = Array(5, 6, 7) 'Columns where you want data be copied'
n = UBound(colRange) - LBound(colRange)
i = 2 'Initial row'
newI = i
maxLen = 10 'Maximum size allowed in one cell'
While Not (Cells(i, colRange(0)) Is Nothing) And (Cells(i, colRange(0)) <> "")
Text = Cells(i, colRange(n))
Do
For j = 0 To n - 1
Cells(newI, destColRange(j)) = Cells(i, colRange(j))
Next j
Cells(newI, destColRange(j)) = Mid(Text, 1, maxLen)
Text = Mid(Text, maxLen + 1)
newI = newI + 1
Loop Until Len(Text) <= 0
i = i + 1
Wend
End Sub
Variables explanation
colRange: Indexes of columns with origin data
destColRange: Indexes of columns where data will be written
i: Initial row
maxLen: Maximum length allowed per cell
Note that this snippet only cares about size of the last cell, if any other has more length it will copy them as they are.
when you run it you got something like
I've never made a VB code, so don't be critic, it surely can be better

Excel formula to space out range depending on other variable

Right - this is a tricky one to phrase so I'm going to use a couple of images to help me.
In Columns A and B is a varying list of team names and the number of players each team has.
Column D contains the desired output.
I need a formula, to be inserted into Cell D2 and dragged down as far as the total of Column B, to return the team names - but crucially to allow a number of rows beneath which return blank. The number of blank rows beneath is effectively equal to 1 - the number of players in that team.
I have given it some thought, but can't come up with a suitable formula. Any ideas?
Also suggestions for a better title are welcome.
The following VBA function will do exactly what you want. Let me know if any part of it is not clear to you.
Sub teamRows()
Dim colDRowNumber As Integer
Dim i As Integer
Dim teamName As String
Dim numberOfRows As Integer
Dim HowFar As Integer
' Loop through the teams in column A
HowFar = Application.WorksheetFunction.CountA(Range("A:A"))
' Variable to keep count of rows in column D
colDRowNumber = 2
For i = 2 To HowFar
' Get the team's name and number of rows
teamName = Range("A" & i).Value
numberOfRows = Range("B" & i).Value
' Fill in the team's name in column D
Range("D" & colDRowNumber).Value = teamName
' Increase the row number by the number of empty rows required
colDRowNumber = colDRowNumber + numberOfRows
Next i
End Sub
A complex but short attempt - I wanted to avoid loops.
Example below works on A2 to A20
y = Split(Join(Application.Transpose(Application.Evaluate("=index(substitute(substitute(substitute(REPT(A2:A20 &"","",B2:B20),A2:A20&"","",""X"",1),A2:A20,""""),""X"",A2:a20),0,1)")), ","), ",")
[d2].Resize(UBound(y)) = Application.Transpose(y)

Excel VBA - Loop through range and set formula in each cell

I've got a workbook where I have one worksheet which contains a lot of data.
My goal is to create a macro that inserts a formula in a separate sheet to copy the data from the first sheet. Lets call the first sheet "Numbers1" and the second sheet "TidyNumbers1".
In the sheet "TidyNumbers1" I want to loop through each cell from column A to M and rows 1 to 60. So I've got a macro that so far looks like this:
Sub updateFormulasForNamedRange()
Dim row, col, fieldCount As Integer
colCount = 13
RowCount = 60
For col = 1 To colCount
For row = 1 To RowCount
Dim strColCharacter
If col > 26 Then
strColCharacter = Chr(Int((row - 1) / 26) + 64) & Chr(((row - 1) Mod 26) + 65)
Else
strColCharacter = Chr(row + 64)
End If
Worksheets("TidyNumbers1").Cells(row, col).Formula = "=IF(Numbers1!E" & col & "<>0;Numbers1!" & strColCharacter & row & ";"")"
Next row
Next col
End Sub
But the formula is supposed to looks like this for Column A, row 2:
IF(Numbers1!E2<>0;Numbers1!A2;"")"
And the formula in Column A, row 3 should look like this:
IF(Numbers1!E3<>0;Numbers1!A3;"")"
Formula in Column B, row 2 should look like this:
IF(Numbers1!E2<>0;Numbers1!B2;"")"
In other words, the formula looks to see if the value in Column E, row % is anything but 0 and copies it if conditions are met.
But, I see that I need to translate my integer variable Row with letters, because the formula probably needs "A" instead of 1. Also, I get a 1004 error (Application-defined or object-defined error) if I just try to use:
Worksheets("Numbers1").Cells(row, col).Formula = "=IF(Numbers1!E" & row & "<>0;Numbers1!" & col & row & ";"")"
I clearly see that the integer row should be translated to letters, if that's possible. Or if anyone has any other suggestions that might work. Also, the 1004 error is unclear to me why happens. I can define a string variable and set the exact same value to it, and there's no error. So it's probably the formula bar that whines about it I guess?
Here is a former post of mine containing functions for conversion of column numbers to letters and vice versa:
VBA Finding the next column based on an input value
EDIT: to your 1004 error: Try something like this:
=IF(Numbers1!E" & row & "<>0,Numbers1!A" & row & ","""")"
(use ; instead of ,, and "" for one quotation mark in a basic string, """" for two quotation marks).
Would not it be easier to get the cell address with the Cells.Address function?
For example:
MsgBox Cells(1, 5).Address
Shows "$E$1"
Best Regards

Resources