VBA nested IF / ElseIF help conditional hyperlink creation - excel

Hoping someone can help – I expect there is something very simple that I am doing wrong.
The situation is this:
I have a table with variable rows (month to month)
Four columns where the one I am trying to place the formula in (CaseLink) is blank
Sample Table
The column ‘System’ has one of three values; CSv1, CSv2, PIA
The Case # column will have numbers – no repetition or consistency
The CaseLink column is where I am having the issue – I am trying to insert one of three hyperlinks to include the value in the Case # column. The link target is based on the value in the System column
Previously I only had two variables in the System column and was able to solve for with a simple IF statement as it was either true or false. Now with a third variable, I am having difficulties with the If / ElseIF format. Here is what I have tried:
Original if statement that works:
Range("C2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-2]=""CSv1"",HYPERLINK(CONCATENATE(""https://open. cloudav.com/servicedeliverdo.aspx?rdx=9992956J43211&conv="",RC[-1]),RC[-1]),HYPERLINK(CONCATENATE(""https://open.topcloudav.com/ha2servicedeliverdo.aspx?conv="",RC[-1]),RC[-1]))"
Range("D3").Select
Option 1: (this returns an error: Sub or Function not defined on Concatenate)
Range("C2").Select
If ActiveCell.Offset(0, -2).Value = "CSv1" Then Hyperlink (CONCATENATE("https://open.cloudav.com/servicedo.aspx?rdx=9992956J43211&conv="),RC[-1]),RC[-1]))
ElseIf ActiveCell.Offset(0, -2).Value = "CSv2" Then Hyperlink (CONCATENATE("https://open.cloudav.com/topservicedo.aspx?conv="),RC[-1]),RC[-1]))
ElseIf ActiveCell.Offset(0, -2).Value = "PIA" Then Hyperlink (CONCATENATE("https://dev.devroot.net/browse/PIA-"),RC[-1]),RC[-1]))
End If
Range("D3").Select
Option 2: (this returns an error indicating ElseIF is undefined
Range("C2").Select
ActiveCell.FormulaR1C1 = _
"IF(RC([-2])) = ""CSv1"" Then Hyperlink (CONCATENATE(""https://open.cloudav.com/servicedo.aspx?rdx=9992956J43211&conv="", RC[-1]), RC[-1])))"
elseif_
ActiveCell.FormulaR1C1 = _
"IF(RC([-2]) = ""CSv2"" then Hyperlink (CONCATENATE(""https://open.cloudav.com/topservicedo.aspx?conv="", RC[-1]), RC[-1])))"
elseif_
ActiveCell.FormulaR1C1 = _
"IF(RC([-2]))= ""PIA"" Then"
Hyperlink (concatenate("https://dev.devroot.net/browse/PIA-", (RC([-1])), (RC([-1]))))
End If
Range("D3").Select
I have also tried ActiveCell.Offset rather than ActiveCell.Formula with similar failure results
Any thoughts?

There a lot of thing that could be improve in your code:
Use variable instead of hard code
do not select
Indent better
I tried to replicate what you were doing,
Sub hyperlink()
Dim firstcellrow As Long ' First row where your code acts
Dim systemcellcollumn As Long ' Column w the system entries
Dim linkcollumn As Long ' Column where you want to link stuff
firstcellrow = 1 ' In my case
systemcellcollumn = 2 'From your image
linkcollumn = 4 'From your image
Dim activecellrow As Long ' Its a long name but thats actualy just a counter
Dim system As String ' Not needed if u use cell.text directly into select case
Dim i As Long
For i = 0 To 2 ' 0 to whatever you want
activecellrow = firstcellrow + i
system = Worksheets("test").Cells(activecellrow, systemcellcollumn).Text ' Not necessary, see comment under "Select Case"
Select Case system
' or Select Case Worksheets("test").Cells(activecellrow, systemcellcollumn).Text
Case "CSv1"
Cells(activecellrow, linkcollumn).FormulaR1C1 = "=IF(RC[-2]=""CSv1"",HYPERLINK(CONCATENATE(""https://open. cloudav.com/servicedeliverdo.aspx?rdx=9992956J43211&conv="",RC[-1]),RC[-1]),HYPERLINK(CONCATENATE(""https://open.topcloudav.com/ha2servicedeliverdo.aspx?conv="",RC[-1]),RC[-1]))"
Case "CSv2"
'etc
Case "PIA"
'etc
End Select
Next
End Sub
This code may not be perfect but is already more general and works

I appreciate all the comments - I am not a professional coder - This is something I am trying to get done by learning from everyone else. If this is not a forum where someone can go to ask for help without getting blasted for style, I apologize for wasting your time.
I did figure out a simple method of getting this done on my own in a single nested IF statement:
Range("C2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-2]=""CSv1"",HYPERLINK(CONCATENATE(""https://open.cloudav.com/deliverdo.aspx?rdx=9992956J43211&conv="",RC[-1]),RC[-1]),IF(RC[-2]=""CSv2"",HYPERLINK(CONCATENATE(""https://open.cloudav.com/topdeliverdo.aspx?conv="",RC[-1]),RC[-1]),IF(RC[-2]=""PIA"",HYPERLINK(CONCATENATE(""https://dev.devroot.net/browse/PIA-"",RC[-1]),RC[-1]))))"
Range("A2").Select

Related

Excel Randomly crash after executing Macro

I am tearing my hair out on this one.
I am trying to add the value from a userform textbox to a table.
However Excel is constantly crashing on me as soon as it runs the code below.
The error message i get is
runtime error -2147417848 "Method 'Value'of object 'Range' failed
then excel crashes
I have tried Option explicit to check i wasnt missing a variable or it was declared incorrectly, i have tried deleting the table and starting again, i have started a new workbook, i have change the table name, i have tried 4/5 different methods of adding the data to the table (Simple range offset, databodyrange(X,1), resizing the table etc). All crash when adding the value (which by the way is just text like mike/harry etc)
The workbook, has about 10 forms and they all work perfectly (they add data to tables etc), it is just this one causing issues
If i manually add data to the table it auto extends and have no issues
any help is appreciated.
Sub Enterprise_Update()
Dim lst As ListObject
Set lst = Sheets("Data Labels").ListObjects("Enterprises")
For Each ctrl In Enterprise_Setup.Controls
If ctrl.Name Like "Enterprise Name Value 1*" Then
z = z + 1
End If
Next ctrl
With lst.Sort
.SortFields.Clear
.Apply
End With
With lst
LstRw = .ListRows.Count
End With
Select Case LstRw
Case Is = 1
lst.DataBodyRange(LstRw, 1).Offset(1, 0).Value = Enterprise_Setup.Controls("Enterprise Name Value 1" & x)
Case Else
For x = 1 To z
sLookFor = CStr(Enterprise_Setup.Controls("Enterprise Name Value 1" & x))
Set oLookin = lst.DataBodyRange
Set oFound = oLookin.Find(what:=sLookFor, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
If Not oFound Is Nothing Then
GoTo err:
Else
With lst
LstRw = .ListRows.Count
End With
End If
r = Enterprise_Setup.Controls("Enterprise Name Value 1" & x).Value
Sheets("Data Labels").Select
Range(lst.Range.Cells(1).Address).End(xlDown).Offset(1, 0).Select
ActiveCell.Value = r
'lst.DataBodyRange(X).Value = r
err:
Next
End Select
With lst.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("Enterprises[Enterprises]"), Order:=xlAscending
.Header = xlYes
.Apply
End With
End Sub
I'm looking at this portion of your code and have some comments on it.
If Not oFound Is Nothing Then
GoTo err
Else
LstRw = Lst.ListRows.Count
End If
r = Enterprise_Setup.Controls("Enterprise Name Value 1" & x).Value
Sheets("Data Labels").Select
Range(Lst.Range.Cells(1).Address).End(xlDown).Offset(1, 0).Select
ActiveCell.Value = r
For one, GoTo err? Err is VBA's error object. VBA is very good at avoiding errors from intrusions on its naming prerogative but I still think its asking for trouble. Note that the final colon is required to identify the label but not the destination statement.
Using labels to jump back and forth in the code isn't good practice. Nor is it needed in this case. A simple If Not oFound Is Nothing Then should do the job if you extend the End If to the point where you have the label. Anyway, what's the point of LstRw = Lst.ListRows.Count? You took that measure before the Select Case statement. Has it changed?
But most of all, I question why you would jump if you found what you were looking for and process when you didn't. This is the best candidate for the error you see.
Selecting another sheet is not good practice and not required, either. You can read from and write to the sheet without selecting it. If you are selecting the sheet from a user form Excel might consider this cause for divorce. Of course, selecting a cell is equally unnecessary.
Range(Lst.Range.Cells(1).Address).End(xlDown).Offset(1, 0) probably works, although I think it's adventurous. But selecting that cell may be problematic when done from within a user form. The form sort of claims right of first attention. I doubt that you can activate that cell from where you are.
You can write to it, however. Sheets("Data Labels").Cells(54, "A").Value = r would be a great success, I feel confident. The contortions you undertake to describe the cell's coordinates aren't necessary. The column seems to be Lst.Range.Column and the row would be Lst.Range.Row + LstRw or perhaps Lst.DataBodyRange.Row + LstRw.
However, there might be additional problems resulting from the location of the cell in a table or just under a table where adding a row might create conflict with data existing there. If the table is required to expand as a result of writing to that cell Excel would normally just over-write whatever might exist but it's a point worth considering if all other options have been exhausted.
I hope this analysis will help you find and correct the error.
I solved the issue by a less than pretty way. I managed to extend the table, and code around the blank rows, ie count none blanks, dynamic named ranges etc

Excel VBA Autofilter field as a variable

I am trying to develop a code that will autofilter a field, that will change month to month.
I have a userform where the user selects the reporting month, then the script finds that month across the top of a structured table, and then drops down 1 row to select the header of the structured table. upon clicking "OK" on the user form.
As the field number "column" will change each time I need to enter this as a variable. I have tried a number of different solutions from other peoples posts, but still no luck.
I don't remember all the different combinations I've tried now.
Private Sub cbOK_Click()
Sheets("Weekly Timesheet").Select
Sheets("Weekly Timesheet").Range("H5").Select
ActiveCell.value = cboRMonth.value
Unload Me
ReportMonth = cboRMonth.value
MsgBox ReportMonth
Sheets("Tracking (DAYS)").Select
Sheets("Tracking (DAYS)").Range("N2").Select
Do Until ActiveCell = ReportMonth
ActiveCell.Offset(0, 1).Select
Loop
ActiveCell.Offset(1, 0).Select
'Tells me what the name of the header is (just to make sure I've got the
right one selected).
Dim Col As String
Col = ActiveCell
MsgBox Col
Dim lCol As Long
lCol = ActiveCell.Column
ActiveSheet.ListObjects("Tracking_DAYS").Range(lCol).AutoFilter _
Criterial:=">0", _
Operator:=x1FilterValues
End Sub
I'm expecting to be able to filter a column of the table based on the output of the userform to values greater than 0.
I wanted to make the field that is filtered in a table dynamic so I first set up a variable that finds the field name (in this case "Year") that I want and gives me the column number of that field:
Range("A1").Select
Dim YC As Long
YC = Rows(1).Find("Year").Column
Then I can use that variable as the field number:
ActiveSheet.ListObjects("TableName").Range.AutoFilter Field:=YC, Criteria1:=Year(Date)

Loop with two table and last row

I'm trying to build a formula:
=BDS(Bonds!J2& " ISIN","ISSUE_UNDERWRITER","Headers","Y")
In one sheet that takes a unique identifier from another table.
These formula builds me a table. After it builds me the table, I need to take the next row in the other sheet:
=BDS(Bonds!J3& " ISIN","ISSUE_UNDERWRITER","Headers","Y")
Then insert that formula a the end of the previous table built by the previous formula.
What I tried was getting the last row and then offsetting it by one, but I'm trying to figure out how to loop through it.
This is what i have tried:
Sub Formula2()Formula2 Macro
Range("A1").Select
ActiveCell.FormulaR1C1 = _
"=BDS(Bonds!R[1]C[9]& "" ISIN"",""ISSUE_UNDERWRITER"",""Headers"",""Y"")"
lRow = Cells(Rows.Count, 1).End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = _
"=BDS(Bonds!R[-53]C10& "" ISIN"",""ISSUE_UNDERWRITER"",""Headers"",""Y"")"
Range("A57").Select
End Sub
Image of Table, Im trying to iterate through the ISIN Column. It is column "J"
Although selection and .select are used by the macro recorder, they cause big problems when developing code. It's worth your time to learn how to replace them with range objects. So, while I'm not directly answering your question, I'm trying to give you the tools to do so.
I've shown an example below to illustrate (although I do not work with the BDS() function so I'm undoubtedly getting the details wrong). The main point is that if you learn to move around using the range object you'll be much better off.
Sub formula()
Dim r As Range, sh As Worksheet, bondR As Range, bondSh as Worksheet
set sh = ActiveSheet
set r = sh.range("A1")
Set bondSh = Worksheets("Bonds")
Set bondR = bondSh.Range("J1")
For i = 1 To 10
r.formula = "=BDS(bondR.offset(i,0) & "" ISIN"",""ISSUE_UNDERWRITER"",""Headers"",""Y"")"
Set r = r.Offset(i, 0)
Next i
End Sub
Here I'm defining one range object, r, to track the location on the active sheet, and another, bondR, for the location on the "Bonds" sheet. Once the initial locations of these ranges are defined, you can manipulate them using the .offset(row,col) function as I've done with the simple for-loop, moving down 1 row (but 0 columns) in each loop.
Feel free to ask questions.

Copying cell values from one Workbook into another

I have the following code that I've written to take some names and use them to populate a timesheet.
Sub InitNames()
Dim i As Integer
i = 0
Dim name As String
Windows("Employee Data.xlsx").Activate
Sheets("Employees").Select
Range("A2").Select
Do Until IsEmpty(ActiveCell)
name = ActiveCell.Value
Workbooks("Timesheet").Sheets("ST").Range("A9").Offset(i * 9).Value = name
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Basically, the cells in the target sheet are spaced 9 rows away from each other, so the first name would go in cell A9, the second in A18, the third in A27, and so on. I'm sure I'm missing something incredibly simple, but I'm not getting any feedback from Excel whatsoever (no error messages). The cells in the timesheet are merged cells, but I cannot change them (locked by the owner), but I don't think that has anything to do with it.
EDIT: I added a line: OriginalValue = Workbooks("Timesheet").Sheets("ST").Range("A10").Offset((x - 2) * 9, 0).Value so I could watch to see what values were being overwritten in my Timesheet and I noticed something interesting: OriginalValue only grabs the first cell's text (A9), thereafter, for every cell (A18, A27, etc.) the debugger indicates that OriginalValue = "" even though those cells also contain names. However, when I open another worksheet and reference A9, A18, etc., I AM pulling the names.
EDIT 2: I modified the test line to read Workbooks("Timesheet").Sheets("ST").Range("A" & ((x - 1) * 9)).Value = "Test" which does change the values in all the target cells. Why would VBA allow me to assign "Test" to a cell value but not the names in the other worksheet?
Try something like this. It will accomplish the task you are requesting without using .Select or .Activate
Sub InitNames()
Dim i As Integer
Dim Wksht as Worksheet
i = 0
Set Wksht = Workbooks("Employee Data.xlsx").Sheets("Employees")
For i = 2 to Wksht.Range("A" & Wksht.Rows.Count).End(xlUp).Row
Workbooks("Timesheet").Sheets("ST").Range("A9").Offset((i-2) * 9,0).Value = Wksht.Range("A" & i).Value
Next i
End Sub

Excel Macro: conditional cut and paste between workbooks

So I want a macro running in an Excel file ("input.xls") that is searching a column in another Excel file ("data.xls") for the value "1" (the only values in that columns are 1s and 0s). When it finds a "1," it should copy and paste the entire row from that file into "input.xls".
Here is the code that I have
Sub NonErrorDataParse()
Dim intEnd As Integer
Workbooks("data.xls").Sheets("Raw").Activate
intEnd = 65000
Range("F").Select
Do Until ActiveCell.Row = intEnd
If Int(ActiveCell.Value) = 1 Then
Range(ActiveCell.Row & ":" & ActiveCell.Row).Cut
intEnd = intEnd - 1
Workbooks("input.xls").Sheets("Non-errors").Activate
Range("A1").Select
ActiveSheet.Paste
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub
However, when I run it, it gives me a "subscript out of range" error on "data.xls." No matter how I fiddle with the code I can't seem to get past that error (even though I have OTHER macros that are accessing that sheet that work fine).
Any ideas as to how to fix it? Or better code that will do the same thing?
Thanks in advance
You don't have to Select or Activate each time you do a command.
You can also find the last used cell with Range("A65536").End(xlup) instead of parsing every cell (that probably caused your error).
The code would then look like:
Sub NonErrorDataParse()
Dim intEnd As Integer
Dim c As Range
intEnd = Workbooks("data.xls").Sheets("Raw").Range("A65536").End(xlUp).Row
For Each c In Workbooks("data.xls").Sheets("Raw").Range("F1:F" & intEnd)
If CStr(c.Value) = "1" Then
c.EntireRow.Cut
Workbooks("input.xls").Sheets("Non-errors").Rows("1:1").Insert Shift:=xlDown
End If
Next c
End Sub
Yet, if you have many rows, it would be faster to use the autofilter method or use a dictionary.

Resources