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/
Related
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
Ok, this might take a bit to explain. I have a single MS Excel setting log sheet for a machine in our plant that contains setting specs for over 100 different part numbers built on that machine (each row is a different part number). We're switching to a new format that will have a separate sheet for each part number, with each sheet following a certain format (I set up a template beforehand and copied it for each part number). The first column of the old log sheet contains all of the part numbers, and the sheet names correspond to these part numbers.
So I'm trying to set up a program that will repeat for each part number (each sheet), and will find that number in the first column of the old log sheet. Then it will pull the value from the cell in, let's say, column B of that row, and will place that value in a specific cell in the sheet for that part number. Now, this will need to pull data from several cells for each part number, but if I can get it to work for one, I can go from there.
Here's what I've got so far:
Sub EditSettings()
Dim i As Integer
Dim j As Integer
Dim lastrow As Integer
lastrow = Sheets("M200 46mm Setting Log").Range("A" & Rows.Count).End(xlUp).Row
For i = 5 To Worksheets.Count
For j = 4 To lastrow
If Sheets("M200 46mm Setting Log").Cells(j, "A").Value = "" Then
ElseIf Sheets("M200 46mm Setting Log").Cells(j, "A").Value = Sheets(i).Name Then
Sheets("M200 46mm Setting Log").Range(j, "B").Copy _
Destination:=Sheets(i).Range("D11")
End If
Next
Next
End Sub
When I run this however, it gives me an error saying "Run-time error '1004': Application-defined or object-defined error".
This is easier than you might imagine. You don't need to loop through each of the worksheets because you can assign the target worksheet by its name: Set ws = WorkSheets([name as a string]). So you really only need to loop through the rows and pick up each sheet name.
I'd also recommend creating an address map of each old sheet cell and its new sheet cell address. In your example, column "B" goes to "D11", so create a collection of all of these and simply loop through them for the copying. There are quicker ways of doing it but with only 100 or so different parts it's not worth worrying about.
The code below shows you how to do both. From your question you mention that you have created templates for each new sheet. Presumably, then, the format is correctly set, so you've no need to do a copy/paste, just write each cell value to the new cell.
By the way, the most obvious error in your code (and probably the reason for your error) is that this line: Sheets("M200 46mm Setting Log").Range(j, "B").Copy ... should be Sheets("M200 46mm Setting Log").Cells(j, "B").Copy ...
Sub RunMe()
Dim wsLog As Worksheet
Dim wsPart As Worksheet
Dim sheetName As String
Dim addressMap As Collection
Dim map As Variant
Dim lastRow As Long
Dim r As Long
Set addressMap = New Collection
' Map the transfer cell addresses
addressMap.Add SetRangeMap("B", "D11")
' 1st item is old log sheet column, 2nd is address of new sheet
' ...
' ... repeat for all the address maps
' ...
'Loop through the rows in the source sheet
Set wsLog = ThisWorkbook.Worksheets("M200 46mm Setting Log")
lastRow = wsLog.Cells(wsLog.Rows.Count, "A").End(xlUp).Row
For r = 4 To lastRow
' Acquire the sheet name from the part number cell
sheetName = CStr(wsLog.Cells(r, "A").Value2)
' Try to assign the parts number worksheet
Set wsPart = Nothing
On Error Resume Next
Set wsPart = ThisWorkbook.Worksheets(sheetName)
On Error GoTo 0
' If assigment worked then transfer data
If Not wsPart Is Nothing Then
For Each map In addressMap
wsPart.Range(map(1)).Value = wsLog.Cells(r, map(0)).Value2
Next
End If
Next
End Sub
Private Function SetRangeMap(sourceCol As String, partAddress As String) As Variant
Dim map(1) As String
map(0) = sourceCol
map(1) = partAddress
SetRangeMap = map
End Function
I'm trying to use VBA for a find/replace. The goal is to iterate through a "Data_Pairs" sheet which contains all the pairs to find/replace, and to find/replace those pairs only in Column A and only in a specified range of sheets in the workbook (which does not include "Data_Pairs").
For some reason, every matching value is replaced, regardless of which column it's in. Values are also replaced in sheets whose index falls outside the defined range.
Any help would be greatly appreciated.
I'm using the following code:
Sub Replace_Names()
Dim row As Integer
Dim row2 As Integer
Dim sheet As Integer
Dim findThisValue As String
Dim replaceWithThisValue As String
For row = 1 To 10
Worksheets("Data_Pairs").Activate
findThisValue = Cells(row, "A").Value
replaceWithThisValue = Cells(row, "B").Value
For sheet = 2 To 10
Worksheets(sheet).Columns("A").Replace What:= findThisValue, Replacement:=replaceWithThisValue
Next sheet
Next row
End Sub
To give a concrete example of the issue: if Data_Pairs A1 = A and Data_Pairs B1 = 1, every single value of 1 in the entire workbook is replaced with A.
I observe this works as-expected in Excel 2010, echoing Greg and chancea's comments above.
HOWEVER, I also observe that if you have previously opened the FIND dialog (for example you were doing some manual find/replace operations) and changed scope to WORKBOOK, then the observed discrepancies will occur, as discussed here:
http://www.ozgrid.com/forum/showthread.php?t=118754
This may be an oversight, because it does not appear to have ever been addressed. While the Replace dialog allows you to specify Workbook versus Worksheet, there is no corresponding argument you can pass to the Replace method (documentation).
Implement the hack from the Ozgrid thread -- for some reason, executing the .Find method seems to reset that. This appears to work:
Sub Replace_Names()
Dim row As Integer
Dim row2 As Integer
Dim sheet As Integer
Dim findThisValue As String
Dim replaceWithThisValue As String
Dim rng As Range
For row = 1 To 10
Worksheets("Data_Pairs").Activate
findThisValue = Cells(row, "A").Value
replaceWithThisValue = Cells(row, "B").Value
For sheet = 2 To 3
Set rng = Worksheets(sheet).Range("A:A")
rng.Find ("*") '### HACK
rng.Replace What:=findThisValue, Replacement:=replaceWithThisValue
Next sheet
Next row
End Sub
You have a Worksheets("Data_Pairs").Activate inside your For ... Next loop. That would seem to indicate that the command is called 9× more that it has to be. Better not to reply on .Activate to provide the default parent of Cells.
Sub Replace_Names()
Dim rw As long, ws As long
Dim findThis As String, replaceWith As String
with Worksheets(1)
For rw = 1 To 10
findThis = .Cells(rw , "A").Value
replaceWith = .Cells(rw , "B").Value
For ws = 2 To 10 ' or sheets.count ?
with Worksheets(ws)
.Columns("A").Replace What:= findThis, Replacement:=replaceWith
end with
Next ws
Next rw
end with
End Sub
See How to avoid using Select in Excel VBA macros for more on getting away from Select and Acticate.
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
In excel I have a column of words which I need to convert to integers. For example, I have a column of industries:
Capital Goods,
List item,
Consumer Services,
Technology, etc.
I want to replace each of these industries with an integer.
Below, something I was trying in VBA but which didn't work. Here I am trying to loop through the column and if the word in the current cell is different from the word in the previous cell then I assign it a different integer. (But it's not working)
Sub WordtoNum()
Dim ws As Worksheet
Dim varList
Dim rng1 As Range
Dim lngCnt As Long
Dim startrow, wsheet, tt As Integer
' Enter the worksheet and starting row
'---------------------------------------
wsheet = 2
startrow = 2
'---------------------------------------
Set ws = Sheets(wsheet)
Set rng1 = ws.Range(ws.[a1], ws.Cells(Rows.Count, "A").End(xlUp))
varList = rng1.Value2
tt = 0
For lngCnt = startrow To UBound(varList)
If varList(lngCnt, 2) <> varList(lngCnt - 1, 2) Then _
tt = tt + 1
varList2(lngCnt, 2) = tt
Next
rng1.Value2 = varList
End Sub
This code is largely based on help I received in a recent, related post.
Why not use the build in Excel function, VLOOKUP? It looks up a word in a sorted column and returns a value from another column, but the same row as the match. Read more on Office Help about VLOOKUP
I realise the question you asked was how to do this in VBA, however, I'm not sure if you really wanted to use VBA as an exercise or just didn't know about this function?