VBA script to replace cell value and keep formatting - vba

I have the below table in word that I'm trying to write a script to replace the contents of the below cell with a different customer payment (i.e replace the £1,100 with £2,000). Below is a snippet of my script but the when I write back to the cell it loses all the formatting and the numbered list.
How can I keep replace the cell data with very similar data and still keep the formatting?
ps. I've simplified the contents of the cell to make it easier to read, so the code won't apply to exactly that content
DescPlan = Trim(t1.Cell(2, 2).Range.Text)
DescTest = InStr(1, DescPlan, ":")
finalString = Left(DescPlan, DescTest)
t1.Cell(2, 2).Range.Text = Replace(DescPlan, finalString, "Payment by the customer of " + Format(v, "Currency") + " will be due upon completion of items below:")

Not sure if this helps but you are using a table so what works for excel should also work for you.
Sub replace_keep_format()
Dim t1 As Range
Dim sStrng As String, rStrng As String
Dim i As Integer
sStrng = "£1,100"
rStrng = "£2,000"
i = 1
Do Until ThisWorkbook.Sheets(1).Range("a" & i) = ""
Set t1 = ThisWorkbook.Sheets(1).Range("a" & i)
t1 = Replace(Expression:=t1, Find:=sStrng, Replace:=rStrng)
i = i + 1
Loop
End Sub

Related

VBA - Struggling with worksheet_change. Not working with no error given

I have a sheet in which our wholesale team are to enter L09 Part Codes and quickly see how much we have in stock of that item. The problem is that new starters may struggle to learn these part numbers as they don't follow a simple rule. What I did was create an easier code to remember which is simply: "Cable Type" & "Core Size" & "Cut Length", they also have the option to add "Colour" and "Brand" separated by spaces.
Their entered string may look like 6242y 2.5 100, or maybe 6242y 2.5 100 Grey, etc. and so where to look in my mapped table for what they've written depends on how many terms they put in. As you can see from the attached picture I need to select the correct column to look in for their code, and then offset back a few columns to suggest the correct L09 Part Number.
I hope the context makes a bit of sense and helps with the below code. The idea was for a new starter to enter something simple and it be replaced before their very eyes...
If anyone could help me to correct the following it would be greatly appreciated:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim P, Products, S, Search As Range
Dim Column As String
Dim Counter As Integer
Dim Spaces As Long
'On Error Resume Next
Counter = 0
'For top table only
If Target.Column = 1 And Target.Row < 100 Then
'Count spaces
Spaces = UBound(Split(Target, " "), 1)
Select Case Spaces
Case Is = 2
Column = "M"
Case Is = 3
Column = "O"
Case Is = 4
Column = "Q"
End Select
'When string has spaces
If Spaces <> 0 Then
'Set simple code range
Set Search = Sheets("Cherries").Range(Column & 1 & ":" & Column & 10000)
For Each S In Search
If S = Target Then
Target = S.Offset(0, 3 - 2 * Spaces)
End If
Next S
End If
Set Products = Sheets("Order Entry").Range("A3:A99")
For Each P In Products
If P.Value <> "" Then
Counter = Counter + 1
End If
Next P
Sheets("Order Entry").Rows("3:" & Counter + 11).Hidden = False
Sheets("Order Entry").Rows(Counter + 11 & ":99").Hidden = True
End If
End Sub
Unfortunately I'm not sure which line is erroring as no error message is given.
Thank you for your time.

Excel conversion of text containing ranges--numeric to alpha-numeric

I would like to convert a range of numbers (and single digits) from a number-only format to alpha-numeric format. Entire statement is in a single, excel cell and would like the converted version to be in a neighboring cell.
As an example:
Assuming 1-24=B1-B24
Assuming 25-48=C1-C24
INPUT—
screen 1-3,5,7-9,11-30,32-37,39-40,41,44-46
DESIRED OUTPUT (all acceptable)
screen B1-B3,B5,B7-B9,B11-C6,C8-C13,C15-C16,C17,C20-C22
OR
screen B1-B3,B5,B7-B9,B11-B24,C1-C6,C8-C13,C15-C16,C17,C20-C22
OR
screen B1-B3,B5,B7-B9,B11-B24
screen C1-C6,C8-C13,C15-C16,C17,C20-C22
Using excel functions is proving quite cumbersome so excel macro would be better. I've looked for examples of requested conversion but haven't found anything.
Any help is greatly appreciated.
Cheers,
Bob
Hey here is a solution that i tested out. Not sure if "screen" needs to be in the string or not. Let me know and I will tweak it if that's the case.
Its a user defined function. So drop this vba in a module and then go to a worksheet and type in "=AlphaConvert(" + the cell reference.
Assumption here is that only one cell will be referenced at a time.
Last this could easily be converted to a sub routine and probably run a bit faster than the function.
Public Function AlphaConvert(TargetCell As Range)
Dim v As Long
Dim vArr() As String
Dim i As Long
Dim iArr() As String
Dim a As String
vArr = Split(TargetCell.Value, ",")
For v = LBound(vArr) To UBound(vArr)
If InStr(vArr(v), "-") > 0 Then
iArr = Split(vArr(v), "-")
For i = LBound(iArr) To UBound(iArr)
If i = LBound(iArr) Then
a = AlphaCode(iArr(i))
Else
a = a & "-" & AlphaCode(iArr(i))
End If
Next i
vArr(v) = a
Else
vArr(v) = AlphaCode(vArr(v))
End If
If v = LBound(vArr) Then
AlphaConvert = vArr(v)
Else
AlphaConvert = AlphaConvert & "," & vArr(v)
End If
Next v
End Function
Private Function AlphaCode(Nbr As Variant)
Select Case Nbr
Case 1 To 24
AlphaCode = "B" & Nbr
Case Else
AlphaCode = "C" & Nbr - 24
End Select
End Function

VBA: Search for a value in a column, find the next cell that match the value if adjacent cell not empty

I'm pretty newbie at coding in vba (i'm actually learning on the spot as i've been required to do it so), and I'm having a little trouble getting this right.
What I need is to be able to search for a value {clave} and then insert the current date into the adjacent cell, but I haven't found the way to do it without having it overwrite the very first match.
At first I thought I could do it with a Loop, but I can't quite put my finger on it and I've been running in circles.
Is I haven't found the solution, I just left it as it is, but heres my code:
Private Sub buscarbtn_Click()
Dim clv1
Dim rnng As Range
clv1 = clavebx.Value
'Insert date
prontuario1.Range("V:Z").Find(what:=clv1, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, -6).Value = Date
'This isn't really relevant, just calling some data into the userform
busbox.Value = Hoja4.Range("D7").Value
mrcbox.Value = Hoja4.Range("D5").Value
corridabox.Value = Hoja4.Range("D8").Value
namebox.Value = Hoja4.Range("D4") & " - " & Hoja4.Range("D6")
fechabox.Value = Date
End Sub
And a quick look at my table so you can picture what I'm trying to do.
Thank you in advance!
Once you found the CLAVE ID check if the cell value is empty, if not empty place the date value.
Private Sub buscarbtn_Click()
Dim clv1 As String
Dim rnng As Range
Dim clave_found As Range
clv1 = clavebx.Value
'Insert date
Set clave_found = prontuario1.Range("V:Z").Find(what:=clv1, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, -6)
With clave_found
If .Value = vbNullString Then
.Value = Date
Else
MsgBox "The [CLAVE] ID found with date: " & .Value
End If
End With
'This isn't really relevant, just calling some data into the userform
busbox.Value = Hoja4.Range("D7").Value
mrcbox.Value = Hoja4.Range("D5").Value
corridabox.Value = Hoja4.Range("D8").Value
namebox.Value = Hoja4.Range("D4") & " - " & Hoja4.Range("D6")
fechabox.Value = Date
End Sub

How do I get all text from all cells to one variable?

I have a large range that I need to find all numbers that is between four and six digits long.
I know I can use regex for this but I don't want to loop each cell and check them all.
What I need is kind of selecting the range copy and paste in notepad and copy back to a variable.
This way I can regex the variable and find all matches at once.
I don't need to know where the number was found, I just need the numbers.
Is there any way to copy the values to a string like this?
Dim text As String
text = ActiveSheet.Range("C9:IQ56").Value
is not compatible datatypes.
If I use variant I get an array of the columns and cells.
My attempt to join the array is not successful either.
text = ActiveSheet.Range("C9:IQ56").Value
textstring = ""
For i = 1 To UBound(text, 1)
textstring = textstring & " " & Join(text(i))
Next i
Any help with this?
use Application Index to do each row at a time:
text = ActiveSheet.Range("C9:IQ56").Value
textstring = ""
For i = 1 To UBound(text, 1)
textstring = textstring & " " & Join(application.Index(text,i,0))
Next i
There are two problems in your code, the declaration and the dimensions of the variable. Here is what you can do:
Dim Text() As Variant
Text = ActiveSheet.Range("C9:IQ56").Value
textstring = ""
For i = 1 To UBound(Text, 1)
For j = 1 To UBound(Text, 2)
textstring = textstring & " " & Text(i, j)
Next j
Next i
Similar approach with delimiters concatenating row strings after loop
Added a Timer and the feature to use separators (delimiters) as well for rows (e.g. "|") as for columns (e.g. ","). Furthermore I demonstrate a way to join all row strings at once after loop via Application.Transpose() just for the sake of the art, though this isn't faster nor slower than #Scott Craner 's valid solution :+).
Code
Sub arr2txt()
Const SEPROWS As String = "|" ' << change to space or any other separator/delimiter
Const SEPCOLS As String = "," ' << change to space or any other separator/delimiter
Dim v
Dim textstring As String, i As Long
Dim t As Double: t = Timer ' stop watch
v = ActiveSheet.Range("C2:E2000").Value ' get data into 1-based 2-dim datafield array
For i = 1 To UBound(v, 1)
v(i, 1) = Join(Application.Index(v, i, 0), SEPCOLS)
Next i
textstring = Join(Application.Transpose(Application.Index(v, 0, 1)), SEPROWS)
Debug.Print Format(Timer - t, "0.00 seconds needed")
End Sub

VBA Word: Inserting Text Form Fields at a Specified Location

I am new to vba and developing a document that prompts the user to select a variable number of values from a combo box list. After selecting the values, I want to insert them in order onto the document itself as a Text Form Field. Let me show you how I generally am trying to get it to work.
First, the user selects values:
[a]
[b]
[c]
And selects an "OK" button. Then, I am attempting to add these selected values into the word document starting at a bookmark. Value "a" should be inserted followed by a space character followed by a blank Text Form Field, followed by two carriage returns. In the end the result should look something like this:
[bookmark]
[a]'_'[blank_a]'^p'
'^p'
[b]'_'[blank_b]'^p'
'^p'
[c]'_'[blank_c]'^p'
'^p'
Where [bookmark] is an invisible bookmark, '_' is a space, and '^p' is a carriage return. Currently my code is as follows:
Dim myRange As Range
Set myRange = ActiveDocument.Range(Start:=ActiveDocument.Bookmarks("START").Range.Start, _
End:=ActiveDocument.Bookmarks("END").Range.End)
For i = 1 To NUMBER_OF_RESPONSES
Selection.FormFields.Add(myRange, wdFieldFormTextInput).Name = "question_" & i
Selection.FormFields.Add(myRange, wdFieldFormTextInput).Result = "response_" & i
Next i
Naturally, there are no insertions of literal spaces or carriage returns yet as I have not figured out how to do it. The result of this code is as follows:
[START][blank_c][c][blank_b][b][blank_a][a][END]
I would like this order reversed and for there to be the aforementioned formatting inserted. Any pointers on how to go about doing it?
I am not sure if I have missed something, but why not relying on simple paragraphs instead on Bookmarks? Here you have a code doing what you want and any other thing (you can modify the ranges of the paragraphs to perform as complex actions as you wish).
Dim curRange As Range
Dim start_i As Integer
Dim end_i As Integer
Dim NUMBER_OF_RESPONSES As Integer
NUMBER_OF_RESPONSES = 3
start_i = NUMBER_OF_RESPONSES + 1 '0
end_i = 1 'NUMBER_OF_RESPONSES
Set curParagraph = ActiveDocument.Paragraphs.First
curParagraph.Range.Text = "[START]"
i = start_i
Do
If (start_i < end_i) Then
i = i + 1
Else
i = i - 1
End If
Set curParagraph = curParagraph.Range.Paragraphs.Add
curParagraph.Range.Text = "[question_" & i & "][" & "response_" & i & "]"
Loop While (i <> end_i)
Set curParagraph = curParagraph.Range.Paragraphs.Add
curParagraph.Range.Text = "[END]"
Solution
Well now I feel silly for asking the question. The solution was pretty simple.
ActiveDocument.Bookmarks("START").Select
For i = 1 To NUMBER_OF_RESPONSES
Selection.Font.Size = 11
Selection.Font.Bold = True
Selection.FormFields.Add(Range:=Selection.Range, Type:=wdFieldFormTextInput) _
.Name = "question_" & i
Selection.Font.Bold = False
Selection.TypeText Text:=" "
Selection.FormFields.Add(Range:=Selection.Range, Type:=wdFieldFormTextInput) _
.Name = "response_" & i
Selection.TypeParagraph
Selection.TypeParagraph
Next i
So the real issue was placing the cursor in the right location:
ActiveDocument.Bookmarks("START").Select
From there I was able to use Selection to insert the desired FormFields and characters.
This link was pretty helpful.
And if you are reading this because you also are new and trying to learn what to do, check out how to record a macro. It's a good first step. Record the macro, view the code it generated, and use that code to guide your own development. Cool.