Hi I'm a bit new to vba so I will try to explain my problem as far as possible.
I have a dataset in Excel in Column A, I have a lot of file names like this:
1. AB000**1234**45.tif
2. AB000**1235**45.tif
3. AB000**1236**45.tif
4. AB000**1237**45.tif
etc..
From this I want to take out all the strong characters and put in column C so it will look like this:
1. 1234
2. 1235
3. 1236
4. 1237
etc..
At the moment I have a code that looks like this:
Sub TakeOut
Dim str1 As String
Dim LR As Long
Dim cell As Range, RNG As Range
LR = Range("A" & Rows.Count).End(xlUp).Row
Set RNG = Range("A1:A" & LR)
For Each cell In RNG
L = Len(RNG)
If L > 0 Then
RNG = ...
End If
Next cell
Range("C:C").Columns.AutoFit
End Sub
I have tried to count left(5) and right(6) but don't know how to take out the 4 character that I want.
Hope you can help me with this.
If you want to take out the strong characters from the string. Try it below. It will take all the Bold Characters in a cell and place it in C column.
Hope you are looking for this?
Sub get_bold_content()
Dim lastrow, i, j, totlength As Long
lastrow = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lastrow
totlength = Len(Range("A" & i).Value)
For j = 1 To totlength
If Range("A" & i).Characters(j, 1).Font.Bold = True Then
outtext = outtext & Range("A" & i).Characters(j, 1).Text
End If
Next j
Range("C" & i).Value = outtext
outtext = ""
Next i
End Sub
Take a look at the Mid() Function link.
usage in your case:
Mid(cell.Value, 6, 4) 'First parameter is the string, 6 is the start character, 4 is length
The easiest way without looping would be something like this:
Sub TakeOut()
Dim rng As Range
Set rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
rng.Offset(, 1) = Evaluate("IF(" & rng.Address & "="""","""",MID(" & rng.Address & ",6,4))")
End Sub
Related
I want to delete all whitespaces in a range and got the following code
Dim rng2 As Range
Dim cleanString2 As String
Set rng2 = ContactData.Range("AR2:AR" & lRow)
rng2.Value = Application.Trim(rng2)
For j = 2 To lRow
cleanString2 = ContactData.Range("AR" & j).Value
cleanString2 = Replace(cleanString2, Chr(10), "")
ContactData.Range("AR" & j).Value = cleanString2
Next j
I got and equivalent code with same variables and everything just without the 2 in the variable names the code works, but the other code goes for colum A instead of AR, can anybody help me with finding the bug?
Thanks!
Dim rng As Range
Dim cleanString As String
Set rng = ContactData.Range("A2:A" & lRow)
rng.Value = Application.Trim(rng)
For i = 2 To lRow
cleanString = ContactData.Range("A" & i).Value
cleanString = Replace(cleanString, Chr(10), "")
ContactData.Range("A" & i).Value = cleanString
Next i
this is the working code, below a picture of the variable values while debugging:
Rather than do it row by row you could replace all whitespace in one hit.
The problem you're finding is that you're referencing different ranges.
The original code states:
Set rng = ContactData.Range("A2:AR" & lRow)
Your code has:
Set rng = ContactData.Range("A2:A" & lRow) - missing the ref to column AR.
You could use the below code to remove the whitespace (Chr(32). As #Rory said - Chr(10) is a linefeed.
Sub Test()
Dim rng As Range
Dim lRow As Long
lRow = 15
Set rng = ContactData.Range("A2:AR" & lRow)
rng.Replace What:=Chr(32), Replacement:="", LookAt:=xlPart
End Sub
Judging from your code, the problem is that you are hoping that:
cleanString = Replace(cleanString, Chr(10), "")
would remove the whitespaces. Chr(10) is not a whitespace as per the ASCII table. Thus, the easiest way is probably to go like this:
cleanString = Replace(cleanString, " ", "")
If this does not work, as a workaround try this:
Public Sub RemoveSpaceInString()
Dim myCell As Range
For Each myCell In Selection
myCell = Trim(myCell)
myCell = Replace(myCell, vbTab, "")
myCell = Replace(myCell, " ", "")
myCell = Replace(myCell, Chr(160), "")
Next myCell
End Sub
It uses Selection, because it was intended to be used outside working code, as a "format-helping" tool. However, if it works, it would be quite easy to write it inside your code.
I have a TextBox and ListBox. I want to find a string in a range containing specific multiple words (keywords) written in TextBox and display it in the ListBox
For example:
I have a string a = "Sun is shinning"
And I want to research the range, find and display cell value containing these specific words when I write in TextBox for example "sun shinning".
Take a look into my last string where I write word "sun" in lowercase.
I wrote the code
Sub AAA()
Dim ws As Worksheet
Set ws = Worksheets("BBB")
Dim LastRow As Long
Dim i As Long
ZZZ.Clear
LastRow = ws.Range("D" & Rows.Count).End(xlUp).Row
With ZZZ
.ColumnCount = 3
.ColumnWidths = "100;400"
For i = 2 To LastRow
' For x = 0 To UBound(z)
If ws.Range("E" & i) Like AAA
.Value & "*" Then
.AddItem ws.Range("D" & i)
.column(1, ZZZ.ListCount - 1) = ws.Range("E" & i)
'.column(2, ZZZ.ListCount - 1) = ws.Range("E" & I)
End If
' Next x
Next i
End With
End Sub
But each time when I try to add second loop responsible for splitting the sentence and loop by each word I get an error message.
Have you got any idea how to simply modify my code to do that?
Assuming multiple words entered into textbox AAA are always entered with spaces, this procedure works (tried and tested).
The procedure uses the Split function to load the word(s) in the AAA textbox into an array, then loops the array for each cell.
Sub AAA()
Dim ws As Worksheet
Set ws = Worksheets("BBB")
Dim LastRow As Long
Dim i As Long
ZZZ.Clear
LastRow = ws.Range("D" & Rows.Count).End(xlUp).Row
With ZZZ
.ColumnCount = 3
.ColumnWidths = "100;400"
For i = 2 To LastRow
Dim sWords() As String, x As Integer
sWords = Split(AAA.Value, " ")
For x = 0 To UBound(sWords)
If ws.Range("E" & i) Like "*" & sWords(x) & "*" Then
.AddItem ws.Range("D" & i)
.Column(1, Sheet1.ZZZ.ListCount - 1) = ws.Range("E" & i)
End If
Next x
Next i
End With
End Sub
As I type this I had the thought that it may be even faster to loop the array once and Find any matches of each word in the entire range, but I will leave that up to you.
I have this problem I'd like to compare two columns in one worksheet to another two columns in other worksheet and then if it's true fill other column with data.
I wrote some code but it worked only till 47 row. don't know the problem. Excel is not responding. Here's my code. Maybe someone can shed some light on what I did wrong
Sub Compare()
Dim i, j As Integer
For i = 2 To 2175
For j = 2 To 3834
If (ActiveWorkbook.Worksheets("Arkusz2").Range("B" & i) = ActiveWorkbook.Worksheets("Arkusz3").Range("A" & j) _
And ActiveWorkbook.Worksheets("Arkusz2").Range("C" & i) = ActiveWorkbook.Worksheets("Arkusz3").Range("B" & j)) _
Then ActiveWorkbook.Worksheets("Arkusz2").Range("E" & i).Value = ActiveWorkbook.Worksheets("Arkusz3").Range("C" & j).Value
Next j
Next i
End Sub
Try this. I added comments on the lines below where I made changes.
Sub Compare()
Dim i as Integer, j As Integer
' You need to specify the value type for *all* variables
Dim ws1 as Worksheet, ws2 as Worksheet
Set ws1 = ActiveWorkbook.Worksheets("Arkusz2")
Set ws2 = ActiveWorkbook.Worksheets("Arkusz3")
' Setting these as their own variables makes the code far more readable
For i = 2 To 2175
For j = 2 To 3834
If (ws1.Range("B" & i).Value = ws2.Range("A" & j).Value _
And ws1.Range("C" & i).Value = ws2.Range("B" & j).Value) Then
' Make sure you are comparing the VALUES and not the range objects
ws1.Range("E" & i).Value = ws2.Range("C" & j).Value
Exit For
' If we've found a match, exit the inner loop early (if it *would* find
' another match, the orig. value would just be overwritten, anyways)
' This will likely reduce the time to complete significantly
End If
Next j
Next i
End Sub
Edit: Added the Exit For to quit the inner loop early after a match has been found. Credit to #Tim Williams for the suggestion.
Having trouble with this code. No errors but also doesn't seem to do anything.
In my sheet, column "M" has some values that start with the letter "T" I want to select the entire row for these. Thanks in advance.
Sub trace1()
Dim trace As String
trace = "T"
Dim LR As Long, i As Long
LR = Range("M" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If Left(Range("M" & i).Value, 1) = trace Then Rows("i:i").Select
Next i
End Sub
One possible way to answer the question as written:
Sub trace1()
Dim trace As String
trace = "T"
Dim LR As Long, i As Long
Dim SelectedRows As Range
LR = Range("M" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If Not SelectedRows Is Nothing Then
If Left(Range("M" & i).Value, 1) = trace Then Set SelectedRows = Union(SelectedRows, Rows(i))
Else
If Left(Range("M" & i).Value, 1) = trace Then Set SelectedRows = Rows(i)
End If
Next i
SelectedRows.Select 'Replace with .Copy if that's what you really wanted.
End Sub
If you are trying to select the row assigned to variable "i", you would use:
Sub trace1()
Dim trace As String
trace = "T"
Dim LR As Long, i As Long
LR = Range("M" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If Left(Range("M" & i).Value, 1) = trace Then Rows(i).Select
Next i
End Sub
"Rows("i:i")" won't work. Try collecting all the addresses of all ranges in one string and then selecting the string. Note the comma which separates each range.
Sub trace1()
Dim sRange As String
Dim trace As String
trace = "T"
Dim LR As Long, i As Long
LR = Range("M" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If Left(Range("M" & i).Value, 1) = trace Then sRange = sRange & "," & i & ":" & i
Next i
Range(Mid(sRange, 2)).Select
End Sub
using AutoFilter to give you the range as is, or the actual address
avoids slow loops
Sub trace2()
Dim strTrace As String
Dim strAddress
Dim rng1 As Range
strTrace = "T"
Set rng1 = Range([m1], Cells(Rows.Count, "M").End(xlUp))
With rng1
.AutoFilter 1, strTrace & "*"
Set rng1 = rng1.Cells(1).Offset(1, 0).Resize(rng1.Rows.Count - 1, 1)
strAddress = rng1.SpecialCells(xlVisible).EntireRow.Address
End With
MsgBox "rows that start with " & strTrace & vbNewLine & strAddress
ActiveSheet.AutoFilterMode = False
End Sub
The expression
Rows("i:i").Select
throws an error -- Rows() won't recognize the text value "i:i" as an argument.
Rows(i).Select
will work. But it won't DO anything you can see, other than the last row should be selected when the code is finished running. You may want to do whatever needs to be done to the "T" rows at the next step in your code before your get to the Next i step.
EDIT:
OK, you want multiple rows selected when the code is finished. That can be done:
Dim RowsDescript As String
Dim trace As String
trace = "T"
Dim LR As Long, i As Long
LR = Range("M" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If Left(Range("M" & i).Value, 1) = trace Then RowsDescript = RowsDescript & i & ":" & i & ","
Next i
If Len(RowsDescript) > 0 Then
RowsDescript = Left(RowsDescript, Len(RowsDescript) - 1) ' removes the last comma
Range(RowsDescript).Select
End If
What you want to end up with is an expression that looks like this:
Range("9:9,12:12,16:16").Select
How you get there is, when a row is identified as having the "T" that you want in it, add the row number and a colon and the row number again and a comma to the string RowDescript. So at the end of the loop, you end up with the string having
9:9,12:12,16:16,
in it. But we need to strip off that last comma, so there's the check for a non-zero length string, remove the last character, and then select those rows.
1."T" is not equal to "t", to remove "case sensitivity" it is required to use LCase or UCase (low case or upper case)
2.Rows("i:i") replaced by Row(i)
Sub trace1()
Dim trace As String
trace = "T"
Dim LR As Long, i As Long
LR = Range("M" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If UCase(Left(Range("M" & i).Value, 1)) = UCase(trace) Then Rows(i).Select
Next i
End Sub
And also one comment, at the final will be selected only last row in range, for example row 1,5 and 10 will start from "T", so at the end will be selected only 10th row
updated against question in the comments
this will allow you to select rows which starting from "t" or "T", but this method allow to select not more than 45 rows.
Sub Macro1()
Dim trace$, LR&, i&, Rng$
trace = "T": Rng = ""
LR = Range("M" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If UCase(Left(Range("M" & i).Value, 1)) = UCase(trace) Then Rng = Rng & i & ":" & i & ","
Next i
Rng = Left(Rng, Len(Rng) - 1)
Range(Rng).Select
End Sub
Use copy/paste one by one row if you need copy rows from one sheet to another, or sort range and select range from first row to the last row where cell value start from "T"
I'm in need of a simple macro that adds the column header values to the contents in the columns of a spreadsheet (preferably values that are specified).
So if possible, I'd like to specify the column names in VBA (Col1="Location") so that the macro is only applied to specific columns.
Example:
If I've specified, "Location" as a column header the macro should look for and A1 has "Location" as the header, then everything in A needs, "Location: " added to the front of it.
Basically, whatever the header is + ": ".
So this:
Location
A04B25
A05B89
B58C23
Would be this:
Location
Location: A04B25
Location: A05B89
Location: B58C23
This macro would need to cycle through each column and add that column header value to the values in the column IF it's on the list.
This is the code that I'm trying to use that isn't working:
Sub AppendHeader()
Dim i, LastCol
LastCol = Range("IV1").End(xlToLeft).Column
For i = 1 To LastCol
If UCase(Cells(1, i).Value) = "Local SKU" Then
Cells(1, i).EntireColumn.Append = UCase(Cells(1, i).Value) + ": "
End If
If UCase(Cells(1, i).Value) = "Supplier's SKU" Then
Cells(1, i).EntireColumn.Append = UCase(Cells(1, i).Value) + ": "
End If
Next
End Sub
Is this what you are trying?
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim preString As String
Dim lastRow As Long, LastCol As Long, i As Long, j As Long
Set ws = Sheets("Sheet1")
With ws
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To LastCol
Select Case Trim(UCase(Cells(1, i).Value))
Case "LOCAL SKU", "SUPPLIER'S SKU"
lastRow = .Range(Split(Cells(, i).Address, "$")(1) & Rows.Count).End(xlUp).Row
preString = .Cells(1, i).Value & ": "
For j = 2 To lastRow
.Cells(j, i).Value = preString & .Cells(j, i).Value
Next j
End Select
Next i
End With
End Sub
There is a similar problem on SO, but I have come up with a different VBA solution. It will change the Number Format of the columns (except for the header row) based on that column's header.
To do this manually, you could select the "Custom" category for Format Cells and enter
"Location: "General;"Location: "#
This will make "Location: " show up in front of numbers, text, dates and such. Any formulas applied to these cells will take into account the prefix (Location:) but suppose you wanted to work with just the values. With this method, you can easily remove the formatting rather than creating a second subroutine to remove the prefix.
The code modifies Siddharth's -- Thank you, sir -- (I have not explicitly declared all the variables as he has, but that is best practice).
Sub Sample2()
Set ws = Sheets("Sheet1")
With ws
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To LastCol
lastRow = .Range(Split(Cells(, i).Address, "$")(1) & Rows.Count).End(xlUp).Row
preString = .Cells(1, i).Value & ": "
Range(Cells(2, i), Cells(lastRow, i)).NumberFormat = _
Chr(34) & preString & Chr(34) & "General;" & _
Chr(34) & preString & Chr(34) & "#"
Next i
End With
End Sub