I have a column with dozens/hundreds of different names, some listed multiple times. Each name is formatted as firstname.lastname. I need to split these up to be correctly listed as firstname lastname. Using the split function, usually the first parameter is the string you need to split.
I have used this before with an array of items to split, but I have always had to list each item in the array. This, of course, is not possible with hundreds of different names.
I have searched, but every answer I find always uses an array, or is discussing how to split into multiple columns.
How can it be written so that the code could loop through the entire column (B, in this case) and split every name, while keeping everything in the one column?
The code will be something like:
nameSplit = Split(all_names_in_column_B, ".")
Select the column, press control and F to bring up Find and Replace, Find "." and replace enter a space (by pushing the spacebar once). Does assume you don't have other text within the cells containing periods.
You could do the same thing in VBA.
Sub TEST()
ActiveSheet.Columns("A").Replace _
What:=".", Replacement:=" ", _
SearchOrder:=xlByRows, MatchCase:=False
End Sub
The code to do this looks like this
Public Sub SplitTest()
Dim ws As Worksheet 'Declare a worksheet variable
Dim sheetName As String: sheetName = "Sheet1" 'Provide the name of the sheet where the data is located
Set ws = ActiveWorkbook.Sheets(sheetName) 'Assign it to the worksheet variable
Dim inputRng As Range 'Declare a range variable
Dim rangeName As String: rangeName = "B1:B5" 'Assign the range location using whatever method you like to select your range
Set inputRng = ws.Range(rangeName) 'Assign the range to the range variable
Dim splitStringArray() As String 'Declare a variable length array of strings to hold the result of the split
Const FirstName = 0 'FirstName is element 0 of splitStringArray
Const LastName = 1 'LastName is element 1 of splitStringArray
Dim enumRng As Range 'Declare a range variable to be used as an enumerator
For Each enumRng In inputRng 'Loop through the range one cell at a time
splitStringArray = Split(enumRng, ".") 'Split the value located in the cell
enumRng.Value2 = splitStringArray (FirstName) & " " & splitStringArray (LastName) 'Overwrite the value in the current cell with the First and Last Names
'separeated by a space, this could be anything
Next enumRng
End Sub
Related
I feel like this should be simple because I have found a million references online on how to do this. I've tried several different combos to no avail.
I am simply trying to reference a column using the LastCol variable within a range, but keep getting the error below. The error occurs on the line labeled with a ->. I've tried several different variations, including using the letter name for the first range paramter with a colon, comma, moving the quotes around, putting "." before the Cells references, etc. Every time I look up how to do this online, it seems like I am doing it right.
This is my code:
Public Sub cmb_orgname_Change()
Dim wb As Workbook
Dim sht As Worksheet
Dim orgname As String
Dim org_position As Double
Dim LastCol, LastRow As Integer
Dim prod_range As Range
Dim cell As Range
Set sht = Sheet1
'get the value of the selected org name from the dropdown
orgname = sht.OLEObjects("cmb_orgname").Object.Value
'find the last column for the number of org names, currently this is not being utilized
LastCol = Sheet3.Range("F2").End(xlToRight).Column
If orgname <> "" Then
Call Clear_ComboBox
-> org_position = WorksheetFunction.Match(orgname, Sheet3.Range(Cells(2, 6), Cells(2, LastCol)), 0) + 6
LastRow = Sheet3.Cells(Sheet3.Rows.Count, org_position).End(xlUp).Row
Set prod_range = Sheet3.Range(Sheet3.Cells(3, org_position), Sheet3.Cells(LastRow, org_position))
For Each cell In prod_range
With sht.OLEObjects("cmb_prodname").Object
Dim test As String
test = CStr(cell.Value)
.AddItem CStr(cell.Value)
End With
Next cell
End If
End Sub
after many different iterations of different searches, I found a function called ADDRESS() that comes after a range. With the ADDRESS function, I was able to make this work! Basically, all I had to do was change my line to the following:
org_position = WorksheetFunction.Match(orgname, Sheet3.Range("F2:" & Sheet3.Cells(2, LastCol).Address()), 0) + 6
And now it is running smoothly. This is the page I found the ADDRESS function and information on: https://software-solutions-online.com/use-vba-range-address-method/
QUESTION
How can I perform a copy of a list of cells, without selecting them?
Say I want to copy the ranges A1, A5 and A7.
They are stored in a string like this: addr = "A1,A5,A7"
If I select them first and copy them, the action works fine:
Range(addr).Select
Selection.Copy
When I paste from my clipboard, I only have the values I selected.
Also, if I perform a Union of Range as suggested here, it would work too without selecting:
Dim rng1 As Range, rng2 As Range, rng3 As Range, rngUnion As Range
Set rng1 = Range("A1")
Set rng2 = Range("A5")
Set rng3 = Range("A7")
Set rngUnion = Union(rng1,rng2,rng3)
rngUnion.Copy
However, I cannot neither select the ranges first, nor knowing before runtime how many ranges I will have to select.
I've tried to do this:
Range(addr).Copy
but when I perform the paste it takes all the values between A1 and A7 (basically A1:A7).
How can I get to copy the single cells without selecting them or uniting them?
BACKGROUND - not necessary to answer the question I guess
I have a listbox in which there is a list of values, that the user can multi-select (they can select like the first, the fourth, the seventh line etc.).
When they do that, I build a collection containing those values:
["value1", "value2", "value3", ... ]
Those values are unique in the spreadsheet (if I run a Find, I only can find one range).
As you can guess, I don't know in advance how many values there will be in the collection.
What I need to do is to make them copy their selection. Hence, I build a collection based on those values:
For j = 0 To Me.longList.ListCount - 1
If Me.longList.Selected(j) Then
tmpColl.Add Split(Split(Me.longList.List(j), " ")(1), " ")(0) '<-- add the story ID to the collection
End If
Next j
and then, I build the string holding the address of my multi-selection:
For j = 1 To tmpColl.Count
With Sheets("Stories list")
Set rng = .Range("A1:A10000").Find(tmpColl(j), lookAt:=xlWhole)
addr = addr & "$A$" & rng.Row & ","
End With
Next j
addr = Left(addr, Len(addr) - 1)
Something like this should work without needing to select the entries. It will split the cell addresses into an array, then iterate those to add the values into a new array for outputting to a sheet.
I've put values in A1,A3,A5, and that will move it to column B. All the code assumes this is working on the ActiveSheet.
Option Explicit
Sub SO_Example()
'Assign a string with the range you want to add
Dim addStr As String: addStr = "A1,A3,A5"
'Split the string by a comma to create an array of cells
Dim cellArr As Variant: cellArr = Split(addStr, ",")
Dim i As Long
'Resize the OutArray to be as large as the number of cells to select
Dim arrOut As Variant: ReDim arrOut(UBound(cellArr))
'Add the items to the array
For i = LBound(cellArr) To UBound(cellArr)
arrOut(i) = Range(cellArr(i)).Value
Next
'Output to column B
Range("B1:B" & i).Value = WorksheetFunction.Transpose(arrOut)
End Sub
I don't know how to best describe this but it's better that I explain my problem in pictures.
I have 2 worksheets:
In worksheet Array, there are certain periods with their corresponding 'Array' associated with them.
In Sheet1, there is a list of strings in the format: dd/mm/yyyy hh:mm:ss AM/PM - # ordered by ascending order of number, then by date and finally by time.
The code I have, generates those values in Sheet1 by extracting the data in Array and listing them out in one cell. The code I've used is.
Sub Filter()
Const Array_FirstRow As Integer = 2 'Indicates the first row (row 2) in Array sheet
Dim Array_RowIndex As Integer 'variable to loop through array values of col A
Dim Summary_PeriodMoment1 As String 'in worksheet Sheet 1
Array_RowIndex = Array_FirstRow
Array_LastRow = Array_RowIndex - 1
Summary_PeriodMoment1 = ""
For Array_RowIndex = Array_FirstRow To Array_LastRow
If Summary_PeriodMoment1 <> " " Then
Summary_PeriodMoment1 = Summary_PeriodMoment1 & ", " & Worksheets("Array").Cells(Array_RowIndex, Array_DateTime_Column).Value
End If
Next
Sheet1.Cells(1, 1).Value = Summary_PeriodMoment1
End Sub
This is slightly confusing and overly complicated to read. Is there any way to add code to :
Sort/group the values by # and consolidate by date (to make it less confusing)? Like so?
Have a separate cell for each value, again categorized by # (I would like to plot these values on a pivot graph later on using other code, so would like it to be in a friendly format
Essentially I would like to do some data reformatting/transposing with a VBA script. Any idea what functions I should use? thanks!
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Update: I have what I need for transposing a string of values in one cell. I wonder if this can be done for multiple cells. I tried using this code:
Sub TextToRows()
'Code for 1.2. section
Dim Arr As Variant
Dim Arr1 As Variant
Dim Arr2 As Variant
Dim InputRng As Range, InputRng2 As Range, InputRng3 As Range, OutputRng As Range, OutputRng1 As Range, OutputRng2 As Range
Set InputRng = Range("B1") 'Cell Containing all the text
Set InputRng1 = Range("B2")
Set InputRng2 = Range("B3")
Set OutputRng = Range("D1") 'First Cell of a column that you want the output there
Set OutputRng1 = Range("G1")
Set OutputRng2 = Range("J1")
Arr = Split(InputRng.Value, ",")
Arr1 = Split(InputRng.Value, ",")
Arr2 = Split(InputRng.Value, ",")
Set OutputRng = OutputRng.Resize(UBound(Arr) - LBound(Arr) + 1)
OutputRng.Value = Application.Transpose(Arr)
Set OutputRng1 = OutputRng1.Resize(UBound(Arr1) - LBound(Arr1) + 1)
OutputRng.Value = Application.Transpose(Arr1)
Set OutputRng2 = OutputRng2.Resize(UBound(Arr2) - LBound(Arr2) + 1)
OutputRng.Value = Application.Transpose(Arr2)
End Sub
Seems it only works for InputRng and not InputRng1 or InputRng2
1.
How to split comma-delimited data in one cell? (Look below)
1.1. If you don't have any other data, and number of records are not more than number of possible columns in excel then transposing within the worksheet is an option (Instead of using the code below).
1.2. (If you have more data than limit of excel columns): Otherwise, you need to use arrays. The code below answers first part of your question. It will split the cell for "," as delimiter.
2.
Then you can use Text to Columns in Data tab and delimiter ":" to get the numbers in one column and dates in another one.
3.
Use How To Transpose Cells In One Column Based On Unique Values In Another Column? to group them based on the numbers.
Sub TextToRows()
'Code for 1.2. section
Dim Arr As Variant
Dim InputRng As Range, OutputRng As Range
Set InputRng = Range("B1") 'Cell Containing all the text
Set OutputRng = Range("D1") 'First Cell of a column that you want the output there
Arr = Split(InputRng.Value, ",")
Set OutputRng = OutputRng.Resize(UBound(Arr) - LBound(Arr) + 1)
OutputRng.Value = Application.Transpose(Arr)
End Sub
I would like to filter a table Column C, based on a drop down list selection.
I have more lines, where I can select Country code form the drop down list.
I would like to filter my table based on the country code selection.
For example:
First line: "54" country code selected
Second line "24" country code selected
And so on....
The table on the other tab will be filtered by the selected country code "54","24".
Can you please help me how can I manage it?
Thank you :)
Sub FilterRangeCriteria()
Dim vCrit As Variant
Dim wsFiltered As Worksheet
Dim wsSelection As Worksheet
Dim rngCrit As Range
Dim rngOrders As Range
Dim Lastrow As Integer
'you need more variables to save the range in an array
Dim valArr As Variant
Dim cl As Range
Dim i As Integer
Set wsFiltered = Worksheets("S") ' I want to filter this tab with "Centre Information" selection
Set wsSelection = Worksheets("Centre Information")
Set rngOrders = wsFiltered.Range("b:b") 'I want to filter this column
Lastrow = Worksheets("Centre Information").Cells(Rows.Count, 2).End(xlUp).Row
myrange = ("b3:b" & Lastrow) ' the value from B3 until last row: this will be the filter data
Set rngCrit = wsSelection.Range(myrange)
vCrit = rngCrit.Value
'I get error here: Autofilter method of range class failed
'Correction: Fill array
ReDim valArr(Lastrow - 3) 'define array size (first two rows are empty + considering the first array position starts with 0)
i = 0
For Each cl In rngCrit 'loop through range
valArr(i) = "=" & cl 'filter for each value + operator
i = i + 1
Next cl
'Correction: use array als range of numbers which shall be matched
rngOrders.AutoFilter _
Field:=1, _
Criteria1:=valArr, _
Operator:=xlFilterValues
End Sub
Comment: If you want to filter for a range, using autofilter you have provide an array which contains all values in string format. Filtering numbers requires an operator: e.g. "=", "<=", etc. Best regards.
my data is as below .
Updated Question
Sub Solution()
Dim shData As Worksheet
Set shData = Sheets("Sheet1") 'or other reference to data sheet
Dim coll As Collection, r As Range, j As Long
Dim myArr As Variant
Dim shNew As Worksheet
shData.Activate
'get unique values based on Excel features
Range("a1").AutoFilter
Set coll = New Collection
On Error Resume Next
For Each r In Range("A1:A10")
coll.Add r.Value, r.Value
Next r
On Error GoTo 0
'Debug.Print coll.Count
For j = 1 To coll.Count
MsgBox coll(j)
myArr = coll(j)
Next j
Range("a1").AutoFilter
Dim i As Long
For i = 0 To UBound(myArr)
shData.Range("$A$1").AutoFilter Field:=1, Criteria1:=myArr(i), _
Operator:=xlAnd
On Error Resume Next
Sheets(myArr(i)).Range("A1").CurrentRegion.ClearContents
If Err.Number = 0 Then
Range("A1").CurrentRegion.Copy Sheets(myArr(i)).Range("A1")
Else
Set shNew = Sheets.Add(After:=Sheets(Sheets.Count))
shData.Range("A1").CurrentRegion.Copy shNew.Range("A1")
shNew.Name = myArr(i)
Err.Clear
End If
Next i
'removing filter in master sheet
shData.Range("a1").AutoFilter
End Sub
When I run above macro I don't know why it is giving Type Mismatch Error after MsgBox coll(j) , simply I want to store data in Array and I'm passing that data , Here I am using For Each r In Range("A1:A10") Where A10 length is static how can I find last written column?
When you add something to collection the key needs to be a string so use:
coll.Add r.Value, CStr(r.Value)
instead of:
coll.Add r.Value, r.Value
You are still assigning coll(j) to a Variant which is not an array.
You need to:
ReDim myArr(1 to coll.Count)
Before your for loop and then in the loop:
myArr(j) = coll(j)
Before attempting to respond to this question, I would like to write what I believe you are trying to accomplish; when you confirm this is what you are trying to do, I will try to help you get working code to achieve it. This would normally be done with comments, but the threads of comments so far are a bit disjointed, and the code is quite complex...
You have data in a sheet (called "sheet1" - it might be something else though)
The first column contains certain values that might be repeated
You don't know how many columns there might be... you would like to know that though
You attempt to find each unique value in column A (call it the "key value"), and display it (one at a time) in a message box. This looks more like a debug step than actual functionality for the final program.
You then turn on the autofilter on column A; selecting only rows that match a certain value
Using that same value as the name of a sheet, you see if such a sheet exists: if it does, you clear its contents; if it does not, then you create it at the end of the workbook (and give it the name of the key)
You select all rows with the same (key) value in column A on sheet1, and copy them to the sheet whose name is equal to the value in column A that you filtered on
You want to repeat step 5-8 for each of the unique (key) values in column A
When all is done, I believe you have (at least) one more sheet than you had key values in column A (you also have the initial data sheet); however you do not delete any "superfluous" sheets (with other names). Each sheet will have only rows of data corresponding to the current contents of sheet1 (any earlier data was deleted).
During the operation you turn autofiltering on and off; you want to end up with auto filter disabled.
Please confirm that this is indeed what you are attempting to do. If you could give an idea of the format of the values in column A, that would be helpful. I suspect that some things could be done rather more efficiently than you are currently doing them. Finally I do wonder whether the whole purpose of organizing your data in this way might be to organize the data in a specific way, and maybe do further calculations / graphs etc. There are all kinds of functions built in to excel (VBA) to make the job of data extraction easier - it's rare that this kind of data rearranging is necessary to get a particular job done. If you would care to comment on that...
The following code does all the above. Note the use for For Each, and functions / subroutines to take care of certain tasks (unique, createOrClear, and worksheetExists). This makes the top level code much easier to read and understand. Also note that the error trapping is confined to just a small section where we check if a worksheet exists - for me it ran without problems; if any errors occur, just let me know what was in the worksheet since that might affect what happens (for example, if a cell in column A contains a character not allowed in a sheet name, like /\! etc. Also note that your code was deleting "CurrentRegion". Depending on what you are trying to achieve, "UsedRange" might be better...
Option Explicit
Sub Solution()
Dim shData As Worksheet
Dim nameRange As Range
Dim r As Range, c As Range, A1c As Range, s As String
Dim uniqueNames As Variant, v As Variant
Set shData = Sheets("Sheet1") ' sheet with source data
Set A1c = shData.[A1] ' first cell of data range - referred to a lot...
Set nameRange = Range(A1c, A1c.End(xlDown)) ' find all the contiguous cells in the range
' find the unique values: using custom function
' omit second parameter to suppress dialog
uniqueNames = unique(nameRange, True)
Application.ScreenUpdating = False ' no need for flashing screen...
' check if sheet with each name exists, or create it:
createOrClear uniqueNames
' filter on each value in turn, and copy to corresponding sheet:
For Each v In uniqueNames
A1c.AutoFilter Field:=1, Criteria1:=v, _
Operator:=xlAnd
A1c.CurrentRegion.Copy Sheets(v).[A1]
Next v
' turn auto filter off
A1c.AutoFilter
' and screen updating on
Application.ScreenUpdating = True
End Sub
Function unique(r As Range, Optional show)
' return a variant array containing unique values in range
' optionally present dialog with values found
' inspired by http://stackoverflow.com/questions/3017852/vba-get-unique-values-from-array
Dim d As Object
Dim c As Range
Dim s As String
Dim v As Variant
If IsMissing(show) Then show = False
Set d = CreateObject("Scripting.Dictionary")
' dictionary object will create unique keys
' have to make it case-insensitive
' as sheet names and autofilter are case insensitive
For Each c In r
d(LCase("" & c.Value)) = c.Value
Next c
' the Keys() contain unique values:
unique = d.Keys()
' optionally, show results:
If show Then
' for debug, show the list of unique elements:
s = ""
For Each v In d.Keys
s = s & vbNewLine & v
Next v
MsgBox "unique elements: " & s
End If
End Function
Sub createOrClear(names)
Dim n As Variant
Dim s As String
Dim NewSheet As Worksheet
' loop through list: add new sheets, or delete content
For Each n In names
s = "" & n ' convert to string
If worksheetExists(s) Then
Sheets(s).[A1].CurrentRegion.Clear ' UsedRange might be better...?
Else
With ActiveWorkbook.Sheets
Set NewSheet = .Add(after:=Sheets(.Count))
NewSheet.Name = s
End With
End If
Next n
End Sub
Function worksheetExists(wsName)
' adapted from http://www.mrexcel.com/forum/excel-questions/3228-visual-basic-applications-check-if-worksheet-exists.html
worksheetExists = False
On Error Resume Next
worksheetExists = (Sheets(wsName).Name <> "")
On Error GoTo 0
End Function