I have a macro that changed a tab name based on cell value (A4) which contains a formula to give the sheet a unique name, but I wanted to see if it was possible to create special case handling occurrences when there's a duplicate. So here's the code:
Sub RenameFromA4()
Dim Msg As String, i As Integer
For i = 5 To Sheets.Count
If Sheets(i).Range("A4").Value = "" Then
Msg = "Sheet " & i & "(" & Sheets(i).Name & ") has no value in A4. Fix sheet, then rerun."
MsgBox Msg, vbExclamation
Exit Sub
Else
On Error GoTo ErrSheetName
Sheets(i).Name = Sheets(i).Range("A4").Value
On Error GoTo 0
End If
Next i
Exit Sub
ErrSheetName: Msg = "Sheet " & i & "(" & Sheets(i).Name & ") could not be renamed. Check if name already used."
MsgBox Msg, vbExclamation
End Sub
The trouble I run into is sometimes duplicates can arise and error out my whole macro where it comes to a complete halt. So I want to add a sequence that when the macro encounters a duplicate add the following formula in cell B3: ="IF(AND(C4="",D4="",D3="",C3=""),TRIM((MID(A2,FIND(":",A2)+2,20))),"")&IF(IFERROR(FIND("West",A2),0)>0," W","")&" "&TRIM(RIGHT(SUBSTITUTE(A2," ",REPT(" ",255)),255))"
and pick from the error or just go back to rerunning the macro.
Any insight on how I can't structure this will be helpful.
You can explicitly check for the existence of a sheet named the same as the value in B4 by using a function like what is described here: Test or check if sheet exists. Then, you can insert something like the following between your On Error... and Sheets(i).Name...:
On Error GoTo ErrSheetName
If SheetExists(Sheets(i).Range("A4").Value) Then
Sheets(i).Range("B3").Formula = "=IF(AND(C4="",D4="",D3="",C3=""),TRIM((MID(A2,FIND(": ",A2)+2,20))),"")&IF(IFERROR(FIND("West ",A2),0)>0,"W ","")&""&TRIM(RIGHT(SUBSTITUTE(A2,"",REPT("",255)),255))"
End If
Sheets(i).Name = Sheets(i).Range("A4").Value
Related
Sub lookuphcpcs()
On Error GoTo errorbox:
Dim hcpcs_code As Long
Dim desc As Variant
hcpcs_code = ActiveCell.Value
If Len(hcpcs_code) > 0 Then
desc = Application.WorksheetFunction.VLookup(Active_cell, 'C:\Users\Username\Desktop\[Fruit Code.xlsx]Sheet1'!$A$2:$B$7, 2, False)
MsgBox "Description for HCPCS Code " & hcpcs_code & " is """ & desc & """"
Else
MsgBox "You did not enter any input!"
End If
Exit Sub
errorbox:
If Err.Number = 1004 Then
MsgBox "No Description found under HCPCS list!"
End If
End Sub
I am not able to put table array value under Vlookup in VBA to point to another excel sheet.
How do I do that?
First, when working with Vlookup you need to handle errors, such as when Vlookup was unable to find a match, you can use If Not IsError(Application.VLookup(.... to achieve this.
Second, in your case you don't need to use On Error GoTo errorbox:, just use the Vlookup error handling I wrote in the first point.
Third, you can use If Trim(ActiveCell.Value2) <> "" Then to verify there is a valid text or number inside ActiveCell rather than empty spaces.
Fourth, you should avoid using ActiveCell, and use fully qualified object instead.
Last, you want to make sure "Fruit Code.xlsx" workbook is open before using the Vlookup, as suggested by #Tim Williams in the comments above.
Modified Code
Option Explicit
Sub lookuphcpcs()
Dim desc As Variant
Dim SourceWb As Workbook
' error trapping in case Fruit Code workbook is closed
On Error Resume Next
Set SourceWb = Workbooks("Fruit Code.xlsx")
On Error GoTo 0
If SourceWb Is Nothing Then
Set SourceWb = Workbooks.Open("C:\Users\Username\Desktop\Fruit Code.xlsx") ' open workbook if it's closed
End If
If Trim(ActiveCell.Value2) <> "" Then ' make sure cell has a string other than space
If Not IsError(Application.VLookup(ActiveCell.Value2, SourceWb.Sheets("Sheet1").Range("A2:B7"), 2, 0)) Then
desc = Application.VLookup(ActiveCell.Value2, SourceWb.Sheets("Sheet1").Range("A2:B7"), 2, 0)
MsgBox "Description for HCPCS Code " & ActiveCell.Value2 & " is """ & desc & """"
Else
MsgBox "No Description found under HCPCS list!"
Exit Sub
End If
Else
MsgBox "You did not enter any input!"
End If
End Sub
I'm very new to VBA and SQL, and I'm currently building a table to be uploaded to SQL onto Excel and using VBA.
I want to essentially say if column I(Check Market) or J(Check m2) have a value that says #NA then go no further and don't carry out the upload or the rest of the code. I think one of the problems might be I already have an IF loop - which is successful and has no errors associated with it.
This is my code so far
'Where Marked sht.Cells(Row,15) = "x" 'FIRST IF LOOP
If sht.Cells(lRow, 15) = "X" Then
'If I or J columns say #N/A then DO NOT continue
If IsError(sht.Cells(lRow, 9).Value) Then MsgBox "Error in Column 'Check Market'"
If IsError(sht.Cells(lRow, 10).Value) Then MsgBox "Error in Column 'Check m2'"
''''At the moment it is the above part that isn't successfully running, it notifies the user of an error but doesn't stop the process.
'Change blank spaces to be Null
*******
sSQL = *******Main part of code goes here******
'execute queries
********
'Put back all the 'null' values to blank
'''''
End If 'END OF IF X LOOP
I'm not clear if there's a possibility that both columns might have an error but I've provided for that just in case.
'If I or J say #N/A then dont proceed with upload.
If iserror(sht.Cells(lRow, 9).value) and iserror(sht.Cells(lRow, 10).value) Then
MsgBox "Errors in both Columns"
ElseIf iserror(sht.Cells(lRow, 9).value) Then
MsgBox "Error in Column 'Check Market'"
ElseIf iserror(sht.Cells(lRow, 10).value) Then
MsgBox "Error in Column 'Check KPI'"
Else: 'Continue
End if
Just adding to your original Code
I(9):Check Market J(10):Check m2
'If I or J say #N/A then dont proceed with upload.
If sht.Cells(lRow, 9).Value = "#N/A" Then
MsgBox "Error in Column 'Check Market'"
Exit Sub
ElseIf sht.Cells(lRow, 10).Value = "#N/A" Then
MsgBox "Error in Column 'Check KPI'"
Exit Sub
Else: 'Continue
Code for exiting with MsgBox
Dim response
response = MsgBox("My message here.", vbYesNo, "My Title")
If response = vbNo Then
Exit Sub
End If
MsgBox ("You clicked YES.")
I'm trying to check the name of the last worksheet and see if it equals "Field_10" . If it does, I don't want it to do anything but if it doesn't, I want to add new worksheets.
Expected output when there is only one sheet titled "Sheet1":
Outputs "Adding new sheets" and adds ten new sheets titled Field_1 all the way up to Field_10.
Expected output when the sheets (Field_1,..., Field_10) have already been added:
Outputs "New sheets already added" and exits if statement.
I've included MsgBoxes to help with debugging. The problem is, whether or not I check if the last sheet name is EQUAL to "Field_10" or NOT EQUAL to "Field_10", it always outputs "New sheets already added".
If ThisWorkbook.Worksheets(Worksheet.Count).Name = "Field_10" Then
'If ThisWorkbook.Worksheets(Worksheet.Count).Name <> "Field_10" Then
MsgBox ("New sheets already added")
Else
MsgBox ("Adding new sheets")
On Error Resume Next
For h = 1 To 10
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Field_" & CStr(h)
Next h
End If
Any help would be appreciated.
Use below sub:
Sub AddSheets()
Dim NewSheetNo As Integer
If ThisWorkbook.Worksheets(Worksheets.Count).Name = "Field_10" Then
MsgBox ("New sheets already added")
Else
MsgBox ("New sheets are being aded...")
On Error Resume Next
For NewSheetNo = 1 To 10
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Field_" & NewSheetNo
Next
End If
End Sub
I am creating a table in my spreadsheet that contains categories, questions and answers for a quiz.
The user is presented with a form, allowing them to navigate around the workbook easily, this also includes a textbox option, allowing them to search for a phrase if they are unsure what category the question/answer may fall into.
I have generated a vlook up to pull from the table of categories/questions and answers to the user on a different worksheet.
I have also generated a count, so I am able to identify how many times this work appears across the quiz table.
My problem is I am struggling to develop a loop so that if the key phrase is found 6 times for example, i want 6 questions and answers to be listed to the user. Currently it is only pulling the final time it is found.
My current code includes the following:
Private Sub CommandButton1_Click()
If Len(search_text) = 0 Then
MsgBox "Please enter a key word to search for!", vbCritical
End If
Dim wordCount As Integer
wordCount = Application.WorksheetFunction.CountIf(Sheet1.Range("A2:c600"), "*" & search_text.Value & "*")
'Else: wordCount = WorksheetFunction.CountIf(Sheet1.Range("A2:c600"), search_text.Value)
If wordCount = 0 Then
MsgBox "No match found"
Else
Sheet2.Range("a7").Value = WorksheetFunction.VLookup("*" & search_text.Value & "*", Sheet1.Range("A2:c600"), 3, False)
Sheet2.Range("b7") = wordCount
End If
End Sub
Any advice on implementing a loop and to allow the question/answer to be printed one after another would be very much appreciated.
I have read many other question pages about this and none seem to match what I am trying to do.
Many thanks in advance
I use a combination of Find and FindNext to search through a range of cells for the term entered in the search_text input field. I added comments to my code to better help you understand what exactly is going on.
I don't know exactly what you need to do with the results when you find them, for now I just display a message box showing the match. We can work on what to actually do with the results if you want to clarify in the comments what exactly you want.
This code assumes you have a worksheet named Results
Private Sub CommandButton1_Click()
Dim rngResult As Range
Dim strFirstAddress As String
Dim i As Long
If Len(search_text.Text) = 0 Then
MsgBox "Please enter a key word to search for!", _
vbCritical
'Stop code exeuction if no search
'term is entered
Exit Sub
End If
'Clear the previous results range
Sheets("Results").Range("A2:C600").ClearContents
'Set i to row 2 of the results worksheet
i = 2
'Look in range A2:C600 of Sheet1
With Sheet1.Range("A2:C600")
'Perform the initial find
Set rngResult = .Find(What:=search_text.Text, LookAt:=xlPart)
'Check to ensure that the term is found
If Not rngResult Is Nothing Then
'Grab the cell address of the first match
'This will help to avoid an infinite loop
strFirstAddress = rngResult.Address
'Continue Searching
Do
'Display the output to you
'MsgBox "Matched '" & search_text.Text & "' to " & rngResult.Value & " in cell " & rngResult.Address
'Put the result on the results page
Sheets("Results").Range("A" & i & ":C" & i).Value = Range("A" & rngResult.Row & ":C" & rngResult.Row).Value
i = i + 1
'Move on to the next result
Set rngResult = .FindNext(rngResult)
'Break out of the loop when we return to the starting point of the search
Loop While Not rngResult Is Nothing And rngResult.Address <> strFirstAddress
End If
End With
'Clean up variables
Set rngResult = Nothing
End Sub
I use a For ... Next loop to insert pictures to an Excel worksheet. The name of the picture comes from column B. Sometimes, there is no corresponding picture on the hard disk. In such cases, Excel will throw an error message and stop running the codes. First, I tried "On Error Resume Next". This is not good because all the codes after the error occurs are executed. So, I tried the following code to try to avoid running codes when the picture is not found. This, however, only catches the first error. Excel still throws an error message ("unable to get the insert property of the pictures class") when the second time a picture is not found. All I want is if an error occurs, Excel would skip the rest of the code and go to the next case. How can this be done? Thanks for any help.
......
On Error GoTo gotoNext
For Each cell In rng
......
Set p = Workbooks(ActiveSheet.Parent.Name).Sheets(Sheet_to_Insert_Picture).Pictures.Insert(Path_Prefix & "\" & _
Replace(cell.Value, "/", "-") & ".jpg") 'when the picture is not found, Excel throws an error
......
gotoNext:
Err.Clear
Next
You can quickly check the existence of the image file with the Dir command. It will return the name of the file (hence a returned string length greater than zero) if it is found.
For Each cell In rng
if cbool(len(dir(Path_Prefix & "\" & Replace(cell.Value, "/", "-") & ".jpg"))) then
Set p = Workbooks(ActiveSheet.Parent.Name).Sheets(Sheet_to_Insert_Picture).Pictures.Insert(Path_Prefix & "\" & Replace(cell.Value, "/", "-") & ".jpg")
end if
next cell