Solved: I am trying to truncate cells in a column from a specific character in a string

[goldbeje]

I have a macro coded to create a new sheet, copy from the first sheet, and paste in specific format to the newly created sheet2. My problem is I cannot get column C to truncate at the end of each cell's string; being "..D" or "...D*". Every cell in column C ends in either "D" or "D*" and I need this removed. Any assistance would be helpful.

Code I am currently working with is shown below. I would like to insert the needed code after

CopyPaste_Sheet2.Hide
ActiveWorkbook.Sheets(2).Activate



Dim r As Range
Dim srcID As String
Dim lr, sR, i, c, INDX As Long
Set r = ActiveSheet.Range("B1:B99").Find(What:="PCR Plate ID", LookAt:=xlPart)
INDX = 1
i = 2
lr = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Range("B" & r.Row & ",C" & r.Row & ",G" & r.Row).Copy Destination:=Sheets(2).Range("B1")
For c = (r.Row + 1) To lr Step 3
srcID = Range("B" & c).Text

With Sheets(2)
.Range("A" & i & ":A" & i + 3).Value = INDX
.Range("B" & i & ":B" & i + 3).Value = srcID
End With

Range("C" & c & ",G" & c).Copy Destination:=Sheets(2).Range("C" & i)
Range("H" & c & ",L" & c).Copy Destination:=Sheets(2).Range("C" & i + 1)
Range("C" & c + 1 & ",G" & c + 1).Copy Destination:=Sheets(2).Range("C" & i + 2)
Range("H" & c + 1 & ",L" & c + 1).Copy Destination:=Sheets(2).Range("C" & i + 3)

i = i + 4
INDX = INDX + 1
Next c

CopyPaste_Sheet2.Hide
ActiveWorkbook.Sheets(2).Activate


UserForm1.Show vbModeless
UserForm1.Left = UserForm1.Left - UserForm1.Width / 2
UserForm2.Show vbModeless
UserForm2.Left = UserForm2.Left + UserForm1.Width / 2

End Sub


Thanks for looking at my frustrations.

J.

[jolivanes]

There should be a better solution but if everything is as in the attachment, this would work.


Dim c As Range '<---- With the other Dim statements
For Each c In Range("C38:C" & Cells(Rows.Count, "C").End(xlUp).Row) '<---- Where required
c.Value = Left(c.Value, 10)
Next c

[goldbeje]

jolivanes,

I have used this code and it seems to only truncate everyother row. Shown below... Also, I modified the code to show a range of more than 38 rows ... (c was taken in the copy range). Do you know why this would happen?

Dim d As Range

For Each d In Range("C10000:C" & Cells(Rows.Count, "C").End(xlUp).Row)
d.Value = Left(d.Value, 10)
Next d

PCR Plate IDSource IDOffset1119416J93174_00111119416J93174_001D *21119416J93174_00131119416J93174_002D42119417J93174_00212119417J93174_002D *22119417J93174_00332119417J93174_003D 43119418J93174_00313119418J93174_004D *23119418J93174_00433119418J93174_004D 44119419J93174_00514119419J93174_005D *24119419J93174_00434119419J93174_006D45119420J93174_00615119420J93174_006D *25119420J93174_0073

[Teeroy]

Goldbeje,

The range you've described would select from the last row of data down to row 10000 rather than the data itself. The following is a little more complex but will match and remove "D" followed by any 0-2 characters at the end of the string (handles "D", "D " or "D *").


Dim Rng As Range '<----- with dims
Dim regEx

Set regEx = CreateObject("vbscript.regexp") '<----- straight after dims

With regEx '<---- Where required
.IgnoreCase = True
.MultiLine = False
.Pattern = "D.{0,2}$"
.Global = True
End With
For Each Rng In Range(Sheets("Sheet2").Range("c2"), Sheets("Sheet2").Range("c" & Rows.Count).End(xlUp))
Rng.Value = regEx.Replace(Rng, "")
Next

[jolivanes]

My code started at Row 38 and will work on all cells in Column C from C38 to the last cell in Column C.
I did not have the problem of every 2nd row.

Your code starts in Cell C10,000 and works it's way down to the last Cell in Column C. Is that what you have in mind?

See the attached Workbook

[goldbeje]

:clap: Teeroy... it worked perfect! Thanks for your assistance.

:clap: jolivanes... yours worked as well. Thanks again!

Hooray!! the assistance was much appreciated.