Excel VBA Looping through cells and replacing their values - excel

I am trying to build a macro that cycles through a column of cells and replaces a two letter country code in that cell with the name of that country. However I get an object not found error when I try to run the macro.
Sub ChangeCountryText()
'
' ChangeCountryText Macro
' Changes country codes
'
For counter = 2 To 20
Set curCell = ActiveSheet.Cells(counter, 1)
Select Case curCell.Text
Case "JP"
curCell.Text = "Japan"
Case "FR"
curCell.Text = "France"
Case "IT"
curCell.Text = "Italy"
Case "US"
curCell.Text = "United States"
Case "NL"
curCell.Text = "Netherlands"
Case "CH"
curCell.Text = "Switzerland"
Case "CA"
curCell.Text = "Canada"
Case "CN"
curCell.Text = "China"
Case "IN"
curCell.Text = "India"
Case "SG"
curCell.Text = "Singapore"
End Select
Next counter
End Sub

The Text property is read-only - you can't set it. Assign to the Value property and it should work (e.g. curCell.Value = "Japan")

I'm sure you have a great reason for using a macro for this, but you may want to look into the LOOKUP or VLOOKUP worksheet functions as a way to do something like this without writing a macro.

You should be able to enter the debugger by clicking to the left of your macro text in the editor and placing a red dot on the line
For counter = 2 To 20
Then you can step through your macro until you get to the error.
Alternatively you can add error handling to your macro
On Error Goto Failed
at the top and before the end sub add
Failed:
'handle error here
"Object not found" is likely from the curCell.Text call (curCell is null, nothing, or invalid, so calling .Text on it is failing) or the ActiveSheet.Cells call (not sure if this can happen)

Related

MS VBA: Why is my nested if statement in a case statement not executing the code based on the combo box value?

I have built the foundation and most of the functionality for a user-form that is supposed to allow a user to pick a category of data and move the cell references of that data between two different options. I have three separate sales categories to select from as the main data in the tables where they are stored. Additionally, for reference, I have a fourth and final category that moves all of the previous three categories at once. So essentially, I have four category selections in a combo box to move the data from a cell for "not-shipping" and "shipping" data for sales. I am using the formula functions for the box to move the data between locations. However, for some reason, I have not been able to get any iteration of my nested statements to work.
If the data is also present in the other shipping status (not shipping change to shipping and vice versa), it deletes the cell reference in the formula with a find and replace statement using strings. I have four option buttons as well that set parameters for time period and the likelihood of shipping. I also have exception handling if statements that flag the cell if the data is already present in one of them so that it doesn't double-count my data. It should send a warning message saying the data is already there.
I have tried changing the basic outline of the nested statements from if/elseif/end if to a SELECT Case case is = "sales category" end select layout. My biggest issue is getting the nested statements to trigger when the prescribed event takes place (either moves the cell reference to the new cell or flags it as already being in that location). Theoretically, it should function exactly like the other three.
I have truncated the code to show a basic overview of the data since the actual code is very long and can be cumbersome to read through.
`
````
Private Sub OKButton_Click()
Dim ws As Worksheet
Dim wb As ThisWorkbook
Dim strfilename As String
strfilename = "C:\Users\user.name\~.xlsm"
Set wb = Workbooks.Open(strfilename)
Set ws = Worksheets(1) 'I want the sub to select the first worksheet in my workbook.
If Quarter.Value = True And ShippingLikely.Value = True Then
Select Case Trim(AddinSales.Value)
Case Is = "Sales Category 1"
If ws.Range("B19").Formula Like "%E12%" Then
oldstr = "+E12"
newstr = ""
Replace ws.Range("B19").Formula, oldstr, newstr
ElseIf ws.Range("Shipping Cell").Formula Like "%E12%" Then
MsgBox "Number is already included in shipping.", vbExclamation
Else
Formula = "+E12"
ws.Range("Shipping Cell").Formula = ws.Range("B20").Formula + Formula
End If
Case Is = "Sales Category 2"
If ws.Range("B19").Formula Like "%E13%" Then
oldstr = "+E13"
newstr = ""
Replace ws.Range("B19").Formula, oldstr, newstr
ElseIf ws.Range("B20").Formula Like "%E13%" Then
MsgBox "Number is already included in shipping.", vbExclamation
Else
Formula = "+E13"
ws.Range("B20").Formula = ws.Range("B20").Formula + Formula
End If
End Select
````
`
ElseIf Quarter.Value = True And NotLikely.Value = True Then
Select Case Trim(AddinSales.Value)
Case Is = "Sales Category 1"
If ws.Range("B20").Formula Like "%E12%" Then
oldstr = "+E12"
newstr = ""
Replace ws.Range("B20").Formula, oldstr, newstr
ElseIf ws.Range("B20").Formula Like "%E12" Then
MsgBox "Number is already included in shipping.", vbExclamation
Call resetform
Else
Formula = "+E12"
ws.Range("B19").Formula = ws.Range("B19").Formula + Formula
End If
Case Is = "Sales Category 2"
If ws.Range("B20").Formula Like "%E13%" Then
oldstr = "+E13"
newstr = ""
Replace ws.Range("B20").Formula, oldstr, newstr
ElseIf ws.Range("B20").Formula Like "%E13%" Then
MsgBox "Number is already included in shipping.", vbExclamation
Call resetform
Else
Formula = "+E13"
ws.Range("B19").Formula = ws.Range("B19").Formula + Formula
End If
Case Is = "All Sales Categories"
If ws.Range("B20").Formula Like "%E12+E13+%" Then
E12 = "+E12"
E13 = "+E13"
E14 = "+E14"
newstr = ""
Replace ws.Range("B20").Formula, E12, newstr
Replace ws.Range("B20").Formula, E13, newstr
Replace ws.Range("B20").Formula, E14, newstr
ElseIf ws.Range("B20").Formula Like "%E12+E%" Then
MsgBox "Number is already included in shipping.", vbExclamation
Call resetform
Else
Formula = "+E12+E13+E14"
ws.Range("B19").Formula = ws.Range("B19").Formula + Formula
End If
End Select
End If
````
````
`
I have the exact same sort of layout for a month period table as well. Note: by table, I do not mean that it the table is one of excel's especially formatted tables with built-in filtering. Mine are just formatted to look like a generic table.
Here is the code for the combo box that is initialized when the user-form is opened up. I do not have them hard-coded in a spreadsheet so if that is a problem, I would love some guidance on making those changes.
`
```
`
Private Sub UserForm_Initialize()
Dim ws As Worksheet
Dim wb As ThisWorkbook
Dim strfilename As String
Dim ctrlType1 As String
strfilename = "C:\Users\user-name\~.xlsm"
Set wb = Workbooks.Open(strfilename)
Set ws = Worksheets(1)
ws.Activate
With AddinSales
.AddItem "Select an Option"
.AddItem "Sales Category 1"
.AddItem "Sales Category 2"
.AddItem "Sales Category 3"
.AddItem "All Sales Categories"
If AddinSales.Value = Null Then
AddinSales.Value = "Select an Option"
End If
.DropButtonStyle = fmDropButtonStylePlain
End With
End Sub`
```
`

what is wrong with this line of vba code for Excel Print

I have a combobox with list of page size in excel. i want to change page sizes with combobox selection change.
Following is not working
Public Sub UpdateSize()
Dim Papersizetext As String
Papersizetext = "xlPaper" & Worksheets("Static").Range("B7").value 'A4 is the value in cell B7
shgenerate.PageSetup.PaperSize = Papersizetext 'not working
shgenerate.PageSetup.PaperSize = "xlPaper" & Combobox1.value 'this also not working
shgenerate.PageSetup.PaperSize = xlPaperA4 'is working - i want above to work.
'shgenerate is sheet name
End sub
You could whip up your own function to parse the input and return the correct enum member:
Private Function PaperSize(ByVal rawSize As String) As Long
Select Case rawSize
Case "A4"
PaperSize = xlPaperA4
Case "A3"
PaperSize = xlPaperA3
Case "A5"
PaperSize = xlPaperA5
Case Else
PaperSize = xlPaperUser ' or some other default
End Select
End Function
For more complex paper sizes, such as "Letter 8.5"x11" 22x28cm" or "Legal 8.5"x14" 22x36cm", you could possibly use InStr to test of the existence of "Letter" and "Legal" to return xlPaperLetter and xlPaperLegal.
Regex might be another approach to parse out the dimensions.
Without more detail though, it's hard to give a satisfactory answer, as this question is actually quite a broad topic.

Run-time Error 1004 on my VBA Excel code - transfer data from one worksheet to another

VBA Code to transfer value of one cell to another worksheet
Sub Button4_Click()
Dim Description As String
Worksheets("Job Order Format").Select
Description = Range("C20")
Worksheets("Job Order Record").Select
Worksheets("Job Order Record").Range("E5").Select
If Worksheets("Job Order Record").Range("E5").Offset(1, 0) <> "" Then
Worksheets("Job Order Record").Range("E5").End(x1Down).Select
End If
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = Description
Worksheets("Job Order Format").Select
Worksheets("Job Order Format").Range("C20").Select
End Sub
The code works for the 1st attempt with no error but for the 2nd attempt I get an error of Run-time Error 1004.
First of all you have to read this article carefully.
The reason because your error is raised only on the 2nd run is because:
On the first run, you have an empty range Worksheets("Job Order
Record").Range("E5").Offset(1, 0);
That range is filled with ActiveCell.Value = Description line;
On the second run, you match the If condition and try to perform the line Worksheets("Job Order
Record").Range("E5").End(x1Down).Select;
You get an error.
So what do you need to do? The solution is very easy:
In your editor, go to Tools → Options → tick the "Require Variable Declaration":
Then go to Debug → Compile VBAProject:
You see the reason of error at once - it is misprint of direction .End(*x1Down*) variable (you have number 1 instead of l letter):
As far as you have the "Require Variable Declaration" switched off -compiler doesn't check the code before run, but when code reaches the line with error - it can't understand what to do and throws an exception.
The other thing is that if you do read the article - you would likely replace 12 lines of your code with only 6, a bit faster code, something like this:
Sub Button4_Click()
Dim Description As String
Dim OrderFormatSht As Worksheet, OrderRecordSht As Worksheet
Set OrderFormatSht = ThisWorkbook.Sheets("Job Order Format")
Set OrderRecordSht = ThisWorkbook.Sheets("Job Order Record")
Description = OrderFormatSht.Range("C20")
If Not Description = "" Then OrderRecordSht.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = Description
End Sub

Why is VLookup not running in Event Change sub

I am having trouble running a VLookup inside a Change Event sub. I have tested all other lines of code and made sure they work, so it's only the VLookup that's not working.
For brief background, I have two sheets. Sheet1 contains the ID (where it could have multiple IDs on separate line, hence the SPLIT function used below), Sheet 2 contains the ID and its Description. What I wanted to do is perform a VLookup upon value change and insert description for each ID as comment into the cell.
The line that is not working for me is: Application.WorksheetFunction.VLookup(IDs(i), Sheet2.Range("A3:B30"), 2, False).
I'm not getting any errors but it jumps right to exitHandler without running the reminder of the logic. I'm certain that the ID exists in the table for the VLookup. If someone can help me point out why it is not working, I will be very appreciated!
Below is a snippet of the code where VLookup is used:
With Target
If .Comment Is Nothing Then
'do nothing
Else
.Comment.Delete
End If
If Target.Value = "" Then
.Comment.Delete
Else
If InStr(Target.Value, vbCrLf) = 0 Then
IDs = Split(Target.Value)
Else
IDs = Split(Target.Value, vbCrLf)
End If
For i = LBound(IDs) To UBound(IDs)
If commentText = "" Then
'Add description for ID as comment
commentText = Application.WorksheetFunction.VLookup(IDs(i), Sheet2.Range("A3:B30"), 2, False)
Else
'Keep on adding description for each ID as comment
commentText = commentText & vbCrLf & Application.WorksheetFunction.VLookup(IDs(i), Sheet2.Range("A3:B30"), 2, False)
End If
Next
.AddComment Text:=commentText
.Comment.Shape.TextFrame.AutoSize = True
End If
End With
exitHandler:
Application.EnableEvents = True
End Sub
As the part of the varible defintions is missing, i would guess that commentText is defined as String. If Vlookup performs a search without a match it will return an error, so the variable has to be defined as Variant otherwise you will get a type mismatch. You wont see the error when you use an On Error Goto-Statement. Also then you should check after a Vlookup if no error occured, i.e with the IsError-Function.
Thank you so much for your replies. Indeed, it should be Application.VLookup and not Application.WorksheetFunction.VLookup. I also had to convert IDs(I) to CLng to prevent 2042 error. Changing commentText to Variant is also needed to see the error code.
In the end, this is what worked for me:
Application.VLookup(CLng(IDs(i)), Sheet2.Range("A3:B30"), 2, False)
Thanks again for all the help!

List a group a names to recall later in code

I have a list of names that I need to filter a pivot table on. I use a Case Select to make the pivot items that are equal to the names visible and all other not visible. Can I make a one time array or list of these 15 names and call the list/array name within the code instead of using the 15 names in multiple locations? I have to fun a pivot table and sort on these names many times.
This is what I am trying to avoid. It works as is, but I'm trying to save myself headaches in the future with modifications.
Set table = Worksheets("Sheet2").PivotTables("PivotTable2")
With table.PivotFields("Assigned to")
For Each PvI In .PivotItems
Select Case PvI.Name
Case "Antone", "Brad", "Cavan", "Chris", "Daneisha", "Edward", "James", "Jonathan", "Joesph", "Karen", "Shaun", "Steve", "Timothy", "Tracey"
PvI.Visible = True
Case Else
PvI.Visible = False
End Select
Next
End With
Try this REVERSE Select Case
Sub Sample()
Dim sNames As String
sNames = "/Antone/Brad/Cavan/Chris/Daneisha/Edward/James/Jonathan/Joesph/Karen/Shaun/Steve/Timothy/Tracey/"
Set Table = Worksheets("Sheet2").PivotTables("PivotTable2")
With Table.PivotFields("Assigned to")
For Each PvI In .PivotItems
Select Case 0 '<~~ Reverse Select case
Case InStr(1, sNames, "/" & PvI.Name & "/", vbTextCompare)
PvI.Visible = False '<~~ This also reverses
Case Else
PvI.Visible = True
End Select
Next
End With
End Sub
Here is a simple way to see how Reverse Select Case works :)
Sub Sample()
Dim sNames As String, NameToCheck As String
sNames = "/Antone/Brad/Cavan/Chris/Daneisha/Edward/James/Jonathan/Joesph/Karen/Shaun/Steve/Timothy/Tracey/"
NameToCheck = "Antoneeeee"
'NameToCheck = "Daneisha"
Select Case 0
Case InStr(1, sNames, "/" & NameToCheck & "/", vbTextCompare)
MsgBox "Not found"
Case Else
MsgBox " Found"
End Select
End Sub
Sure and it eliminates the Select Case. I tested the code below minus the pivot table aspect. This stores your names in an array. You can keep the array as a global variable or as a range in the workbook (for the latter change the nameArr = ... line). The code (UBound(Filter(nameArr, PvI.Name)) > -1) will check if PvI.Name exists in nameArr by filtering the array for your desired name and checking if the resulting array has anything in it. Then the true/false value returned by the "array contains check" is assigned to PvI.Visible.
Dim nameArr As Variant
nameArr = Array("Antone", "Brad", "Cavan", "Chris", "Daneisha", "Edward", "James", "Jonathan", "Joesph", "Karen", "Shaun", "Steve", "Timothy", "Tracey")
Set table = Worksheets("Sheet2").PivotTables("PivotTable2")
With table.PivotFields("Assigned to")
For Each PvI In .PivotItems
PvI.Visible = (UBound(Filter(nameArr, PvI.Name)) > -1)
Next
End With
Elaborating on my comment, I recommend a table-driven approach.
The first thing to do is put the names of interest in a worksheet, and give that range a name. I called the range "MyNames" in this example.
The second thing to do is add this function to your project:
Function NameIsInList(LookFor As String) As Boolean
On Error GoTo Err_NameIsInList
NameIsInList = WorksheetFunction.Match(LookFor, Range("MyNames"), 0) > 0
On Error GoTo 0
Exit Function
Err_NameIsInList:
' the name was not found, or a bad parameter was supplied
NameIsInList = False
On Error GoTo 0
End Function
Finally, modify your procedure to use the function:
Set table = Worksheets("Sheet2").PivotTables("PivotTable2")
With table.PivotFields("Assigned to")
For Each PvI In .PivotItems
PvI.Visible = NameIsInList(PvI.Name)
Next
End With
The advantages I was shooting for here are:
Table-driven: The list of values can be stored in a worksheet where it's easily accessible and modified. (If you don't want users to see the LOV you can always hide the worksheet.)
Reusable: Let the function do the work of checking the name list. You suggest this is something that needs to be done many times; the function can be called from multiple places.

Resources