vba to concatenate cells and keep bold formatting - excel

I looked for several hours for a satisfactory answer to this question and couldn't find one, so I rolled my own.
For example, suppose cell A1 = "word1", A2 = "word2", A3 = "word3", and A4 = "word4."
I want B1 to be "word1 word2 word3 word4 "
If none, any, or all the words in column A are bold, I want that reflected in B1. Like this:
partial sheet image
Sub test1()
Dim Row As Integer
Dim Start As Integer
Dim Length As Integer
' concatenate the words with a space between each
Range("B1").Value = ""
For Row = 1 To 4
Range("B1").Value = Range("B1").Value & " " & Cells(Row, "A").Value
Next Row
' match bold formatting
Start = 1
For Row = 1 To 4
Length = Len(Cells(Row, "A").Value)
Range("B1").Characters(Start, Length + 1).Font.Bold = Cells(Row, "A").Font.Bold
Start = Start + Length + 1
Next Row
End Sub
I found I needed two separate loops to make this work. With one loop, Excel made bold all the words following the first bold one, except the last word if it was not bold.
Why did I need (Start, Length + 1) in the code above?

I know this is not an exact answer but maybe can provide you ideas:
With ActiveCell.Characters(Start:=13, Length:=6).Font
.FontStyle = "Bold"
End With
You need to find how to set your Start and Length values using the functions that fit your needs.
The usage of Length + 1 makes that select all the text in your cell before Start.

Related

Give results in next column of predefined (but changing) words from text-cell

I have a chart with a text-column with numerous entries per cell.
Entries are separated with “;”.
Entries have the format “xy 00/00” (e.g. “AB 03/18”).
I need Excel to find and give in the next column a specific entry I predefine per row (above the column, example below).
Only the first two and last two characters are defined, the characters in the middle can be whatever (e.g. “AB ??/18”).
A cell can have more than one entry with the definition of “AB ??/18” (e.g. “AB 03/18” & “AB 08/18” etc.).
I need to know, if there are more than 1 of this predefined entries.
If I change the search box to “ZZ ??/12”, it should overwrite the previous defined search and give me back only the ZZ… ones.
For example:
Screenshot Chart
I tried a formula, but it gives me the first AB…, not the rest.
If it is only possible to give back the amount of the searched text in the cell above, that would also be ok.
Your screenshot doesn't seem entirely consistent with your objective, i.e.
the pattern AB ##/18 can be found 3 times in the string
blabla WF 12/23; AB 08/18; AB 09/18; AB 08/18
but your count column registers only 1 result (for AB 08/18)- there is also a match in the 1st row (for AB 12/18), but there you have a count of 0...
The code below assumes that the 4 data cells from your screenshot are in the range A3:A6 and that they are not part of a table
Sub txtMatching()
Dim results As String, cell As Range, incidence As Integer, pattern As String, pos As Integer, temp As String
pattern = "AB ##/18"
For Each cell In Range("A3:A6")
pos = 1
If cell.Value Like "*" & pattern & "*" Then
Do
pos = InStr(pos, cell.Value2, Mid(pattern, 1, InStr(1, pattern, "#") - 1))
If pos = 0 Then Exit Do
temp = Mid(cell.Value2, pos, Len(pattern))
If temp Like pattern Then
results = results & temp & "; "
incidence = incidence + 1
End If
pos = pos + Len(pattern)
Loop While pos < Len(cell.Value2)
cell.Offset(0, 1).Resize(1, 2).Value2 = Array(Mid(results, 1, Len(results) - 2), incidence)
results = vbNullString
incidence = 0
Else
cell.Offset(0, 2).Value2 = 0
End If
Next cell
End Sub

If column A equals a certain value, generate a value in column B. Check each cell in column A --> Generate a value in each cell in column B

I have a very simple question that I can't find the answer to.
Here is an example of what I'd like to do:
Sample Data
If a row in column A = 'Sandwiches', I would like column B to display 'It's a Sandwich'
If a row in column A = 'Wraps', I would like column B to display 'It's a Wrap'
etc. etc.
So far, I am able to do this for the first row. I'm having trouble creating a for loop to loop through all the available cells.
Here is what I have so far (was thinking of adding Else If statements for different values later):
Current If Statement
If you prefer the use of VBA code instead a formule as Ozgun Senyuva suggested. You can try this code:
Sub Food_and_thing()
Dim myLine As Double
Dim myFood As String
Set SavedData = Sheets("SavedData")
myLine = 2
With SavedData
Do While .Cells(myLine, 1) <> "" 'Assume that Category is in column A, and Generated Asset Name is in column B
myFood = " an other thing"
If .Cells(myLine, 1) = "Sandwiches" Then
myFood = " a Sandwich"
ElseIf .Cells(myLine, 1) = "Wraps" Then
myFood = " a Wrap"
ElseIf .Cells(myLine, 1) = "Salads" Then
myFood = " a salad"
End If
.Cells(myLine, 2) = "It's" & myFood
myLine = myLine + 1
Loop
End With
End Sub
Akash you do not need to write vba codes for this. You may use a lookup table and apply Vlookup formula as #BigBen said.
Apart from this, this formula can make you happy if you ignore some spelling errors. Enter this in cell B2 and paste along the way down.
="It's " & A2

VBA Insert set number of rows if string found

I am new to macros in Excel, and I’m trying to speed up a process. I need to add a varying number of blank rows, if certain text is present in the cell above it. Not equal, but containing.
For example if A1 contains 'Apples', add two blank rows beneath. If A6 has 'Plums', add four blank rows beneath, etc.
What I have now is this:
For a=1 To ActiveSheet.Cells(Rows.Count,1).End(x1Up).Row
If ActiveSheet.Cells(a,1).Value = “Apples” Then
ActiveSheet.Rows(2).Insert
a = a+1
ELSE
If ActiveSheet.Cells(a,1).Value = “Plums” Then
ActiveSheet.Rows(4).Insert
a = a+1
End If
End Sub
So far I've gotten a Compile Error, stating "Block If without End If" though I believe I closed them both. I'm not sure if I'm correctly comparing or searching for a string as well (referring to my use of ="Apples"), but cannot get it to run at all to test that part.
For a = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
If TypeName(ActiveSheet.Cells(a, 1)) = "String" Then
If ActiveSheet.Cells(a, 1).Value = "Apples" Then
ActiveSheet.Rows(2).Insert
a = a + 1
ElseIf ActiveSheet.Cells(a, 1).Value = "Plums" Then 'One error here
ActiveSheet.Rows(4).Insert
a = a + 1
End If
End If
Next 'And here too

In Excel VBA, extract range text and sum data

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

EXCEL vba - extract numbers from cell and paste into two different columns?

I have a spreadsheet with a load of random text and numbers in column A like so:
Column A
Row 1 = 471806121601 5205569 - 0007 Standard White Toilet Tissue 27
Row 2 = 471814121601 5206177 - 0014 Premium White Toilet Tissue 6
Row 3 = 471814121601 5206178 - 0007 Premium White Toilet Tissue 27
Row 4 = 471806121601 5206180 - 0014 Premium Kitchen Towel 2x75l 6
I have about 2000 lines in total. In each cell, is a Purchase order number (12 digits) and an item number next to it (7 digits).
I am trying to extract the po number and put it into column B and extract the item number and put it into column C
Column B Column C
471806121601 5205569
471814121601 5206177
471814121601 5206178
471806121601 5206180
Here is my code:
Option Explicit
Sub main()
Dim cell As Range
Dim arr As Variant, arrElem As Variant
With Worksheets("Orders") '<--| change "Strings" to your actual worksheet name
For Each cell In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
arr = Split(Replace(cell.Value, " ", " "), " ") '<--| change "A"'s to your actual relevant column index
For Each arrElem In arr
If IsNumeric(arrElem) Then
If Len(arrElem) = 12 Then cell.Offset(0, 1).Value = arrElem
End If
Next arrElem
Next cell
End With
Dim cell2 As Range
Dim arr2 As Variant, arrElem2 As Variant
With Worksheets("Orders") '<--| change "Strings" to your actual worksheet name
For Each cell2 In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
arr2 = Split(Replace(cell2.Value, " ", " "), " ") '<--| change "A"'s to your actual relevant column index
For Each arrElem2 In arr2
If IsNumeric(arrElem2) Then
If Len(arrElem2) = 7 Then cell2.Offset(0, 3).Value = arrElem2
End If
Next arrElem2
Next cell2
End With
End Sub
This code does work. However it takes absolutely ages and only does one line at a time...Slowly.
Is there a quicker way of doing this? Thanks
If your PO and IN are always the same length in col B put
=MID(A2, 1, 12)
And in col C
=MID(A2, 14, 7)
However if your number change but are always the first two swap the above for,
=MID(A2,1,FIND(" ",A2,1)-1)
And
=MID(A2, FIND(" ", A2, 1)+1, 7)
Respectively.
just use split(string,delimiter)(0) and (1) why replace the space, just use that as the delim. If Row # is in, then use (1) and (2), or you could consider split(split(input,"-")," ") maybe a little faster, not sure though. Also, once you're done no need to complete the loop, so consider, do until with flags rather than for next, although exit for is available
Formula wise, it could be done using something like this
=MID(D1,FIND("é",SUBSTITUTE(D1," ","é",3)),FIND("é",SUBSTITUTE(D1," ","é",4))-FIND("é",SUBSTITUTE(D1," ","é",3)))
and
=MID(D1,FIND("é",SUBSTITUTE(D1," ","é",4)),FIND("é",SUBSTITUTE(D1," ","é",5))-FIND("é",SUBSTITUTE(D1," ","é",4)))

Resources