I was tasked with creating a code that will check to see if internal hyperlinks in an excel spreadsheet worked. This code first changes the formulas that were on the spreadsheet and makes them actual hyperlinks (they were originally formulas linking the locations together). The problem that I have now is that I want to create hyperlinks ONLY if Column S has text. If it doesn't, I don't want the "E-COPY" text to be displayed. All of the text in Column S varies (not one line has the same characters), which is why I'm drawing a blank is to how I tell the program to only continue if it has any text, not anything specific. I am working with Excel 2016.
Also, I am doing this to 71935 and counting rows; is there a limit to how many it can go through? If so, what can I do about it?
Thank you!
Sub CreateHyperlinks()
Dim FN As Variant
Dim Path As Variant
Dim count As Variant
Sheets(1).Activate
count = WorksheetFunction.CountA(Sheets(1).Range("A:A"))
For i = 2 To count
If Range("AM" & i).Value = "Yes" And Columns("S") = Then
Range("E" & i).Value = ""
Path = Sheets(1).Range("R" & i).Value
FN = Sheets(1).Range("S" & i).Value
Sheets(1).Range("E" & i).Select
Selection.ClearFormats
Selection.Hyperlinks.Add Anchor:=Selection, Address:=Path & FN, TextToDisplay:="E-COPY"
Range("AM" & i).Value = " "
End If
Next i
End Sub
If you just need to check for any content in ColS then:
If Range("AM" & i).Value = "Yes" And Len(Range("S" & i).Value) > 0 Then
Few things:
'make a reference to the sheet you're working with
Dim ws As Worksheet
Dim wb As Workbook
Set wb = Excel.Application.ThisWorkbook
Set ws = wb.Worksheets(1)
'gets the absolute last row with data in it // ignores empty cells
count = ws.UsedRange.Rows.Count
personally, i hate working with named ranges, so i would suggest setting range references like so
what you wrote
Path = Sheets(1).Range("R" & i).Value
what i believe it should look like
Path = ws.Cells(i, 18).Value
if you want to test the type when working with variants, try this:
'tests the type associated with the variant. an 8 = string
If VarType(ws.Cells(i, 19).Value) = 8 Then
'do your thing
'tests if the value is null
ElseIf VarType(ws.Cells(i, 19).Value) = 0 Then
'do your other thing
here's a list of the vartype enumeration to help you out.
hope it helps!
Related
I am posting here again and need very much working and specific codes for making a VBA macro for copying some specific cells from one worksheet to another using one button.
Here you can see my current invoice format -
And here is the Database sheet -
Problem here is - Using the New Invoice button, I want to move to a new invoice while the data from specific cells, Invoice#, Order#, Sale#, Date#, Client's Name, Subtotal, Order Type, will be copied or moved from Invoice sheet to Database sheet. Also, the contents of these cells will be cleared as well.
I have the code for clearing contents and adding new invoice number -
Sub NewInvoice()
Range("H8").Value = Range("H8").Value + 0.00001
Range("D8:D10").ClearContents
Range("C13:C23").ClearContents
Range("H9:H10").ClearContents
Range("H25:H27").ClearContents
UserForm1.Show
End Sub
I need to add the codes for copying data from one worksheet to another worksheet inside this same code, for the specific cell data.
I hope I could explain my situation here.
Waiting for your reply and thank you for your time and consideration.
With regards
Imran
This should do it...
Sub moveData()
Dim db_next_row As Long
Dim invoice_n, order_n, sales_n, date_n As String
Dim c_name, subtotal, order_type As String
'CONFIG HERE
'set the location of the cells in the invoice sheet
'------------------------------------------
invoice_n = ""
order_n = "" 'example: order_n = "B3"
sales_n = ""
date_n = ""
c_name = ""
order_type = ""
subtotal = ""
'-----------------------------------------
db_next_row = Sheets("Database").Cells(Rows.Count, 2).End(xlUp).Row + 1
'move info to database
With Sheets("Database")
.Range("B" & db_next_row) = Sheets("Invoice").Range(date_n)
.Range("C" & db_next_row) = Sheets("Invoice").Range(c_name)
.Range("D" & db_next_row) = Sheets("Invoice").Range(invoice_n)
.Range("E" & db_next_row) = Sheets("Invoice").Range(order_n)
.Range("F" & db_next_row) = Sheets("Invoice").Range(sales_n)
.Range("G" & db_next_row) = Sheets("Invoice").Range(subtotal)
.Range("H" & db_next_row) = Sheets("Invoice").Range(order_type)
End With
'clear content in the invoice
With Sheets("Invoice")
.Range(date_n).ClearContents
.Range(c_name).ClearContents
.Range(invoice_n).ClearContents
.Range(order_n).ClearContents
.Range(sales_n).ClearContents
.Range(subtotal).ClearContents
.Range(order_type).ClearContents
End With
End Sub
I am trying to copy and paste the entire entire columns values from sheet named Hey, to another columns in a sheet named final.
I dont want to use copy, paste or select option.However, my code is copying only the 1st line.
IntLastRow = Sheets("Hey").Cells(Cells.Rows.Count, "A").End(xlUp).Row
' IntRLastRow = Sheets("Interdiction Review").Cells(Cells.Rows.Count, "A").End(xlUp).Row
If Sheets("Hey").Range("H2") = "" Then
Sheets("Final").Range("A2").Value = Sheets("Hey").Range("G2:G" & IntLastRow).Value
ElseIf Sheets("Hey").Range("H2") <> "" Then
Sheets("Final").Range("A2").Value = Sheets("Hey").Range("H2:H" & IntLastRow).Value
EndIf
maybe do you know what I am doing wrong?
I need to copy dates from 2 or more columns to another column located in a different worksheet.
However, I am not sure if I can use 2 last row in the same line.
I am trying this code, but only paste the value of 1 line.
intrlastrow = Sheets("Final").Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
Debug.Print intrlastrow
If Sheets("Hey").Range("AJ2") = "" Then
Sheets("Final").Range("A" & intrlastrow, "A" & IntLastRow).Value = Sheets("Hey").Range("AI2:AI" & IntLastRow).Value
ElseIf Sheets("Hey").Range("AJ2") <> "" Then
Sheets("Final").Range("A" & intrlastrow, "A" & IntLastRow).Value = Sheets("Hey").Range("AJ2:AJ" & IntLastRow).Value
End If
I need to add the values of 2 or more columns from sheet named HEY to the same column in the destination sheet (Final sheet)
Unless the range you are trying insert the values from is as large as the one you are taking them from, only the data which fits will be copied. Changing your code to something like
Option Explicit
Sub test()
Dim IntLastRow As Long
IntLastRow = Sheets("Hey").Cells(Cells.Rows.Count, "A").End(xlUp).Row
' IntRLastRow = Sheets("Interdiction Review").Cells(Cells.Rows.Count, "A").End(xlUp).Row
If Sheets("Hey").Range("H2") = "" Then
Sheets("Final").Range("A2:A" & IntLastRow).Value = Sheets("Hey").Range("G2:G" & IntLastRow).Value
ElseIf Sheets("Hey").Range("H2") <> "" Then
Sheets("Final").Range("A2:A" & IntLastRow).Value = Sheets("Hey").Range("H2:H" & IntLastRow).Value
End If
End Sub
should do the trick.
You probably notice that I've changed Sheets("Final").Range("A2") to Sheets("Final").Range("A2:A" & IntLastRow), similar to what you've done to decide what range to copy values from.
My situation is as follows. I have a list of around 2k student accounts and sort the information to a specific format that i can format to our new CRM. The way the data is presented initially makes that problematic.
As you can see on the first screenshot, every student's university choice is presented in a separate row. So if a student has chosen more than one university, data about it is stored in 2-6 rows (each student can select 1 to 6 universities) repeating his personalID, name, forename and DoB every line.
What I need to achieve is to remove repeating information and store all data about each student in one row per student(example on screenshot 2).
I have no idea how to achieve this using VBA. I was trying with IFs, loops and arrays but without any progress. I need help on how to accomplish that using VBA.
Please let me know if you need more information. I will try to explain it in more details if required.
Screenshot 1
Screenshot 2
EDIT: This is the part of the report. I am working on a macro that will format it to our needs and will give us more info about the student's accounts. That is why I am asking for help in VBA.
No need to use VBA for this. Power Query will help you better. Have a look here: https://excelgorilla.com/power-bi/power-query/aggregate-text-values-using-group-by/
This seems to work. I'm new to VBA and programming in general so it's possibly not the most efficient solution and can definitely be improved.
Instead of working with a blank sheet, it transforms the current data to the format you wanted. You can add field headings where you want.
Edit: It assumes that each Student has 5 universities in the list. The code can be adjusted to account for any number by just adjusting the target range dynamically.
Edit 2: I added the change to account for students who've entered any number of universities between 1 to 5. Let me know if this gets it done!
Sub ReArrange_Data()
Dim lrow As Long
lrow = Cells(Rows.Count, 1).End(xlUp).Row
Dim First As Integer
Dim Last As Integer
Dim test As Integer
Dim test1 As Integer
Dim student_range As Range
Dim student_rows As Integer
Dim target_range As Range
First = 2
For i = 2 To lrow
Last = First
If Cells(First, "D").Value = "" Then GoTo Break 'reached end of data
While Cells(Last, "D").Value = Cells(Last + 1, "D").Value
Last = Last + 1
Wend
If Last <> First Then 'check if mulitiple uni and build range
Set student_range = Range("E" & First & ":" & "E" & Last)
student_rows = student_range.Rows.Count
If student_rows = 5 Then
Set target_range = Range("E" & First & ":" & "I" & First)
ElseIf student_rows = 4 Then
Set target_range = Range("E" & First & ":" & "H" & First)
ElseIf student_rows = 3 Then
Set target_range = Range("E" & First & ":" & "G" & First)
ElseIf student_rows = 2 Then
Set target_range = Range("E" & First & ":" & "F" & First)
End If
Else
GoTo Skip 'student entered one uni, go to next loop
End If
target_range = Application.WorksheetFunction.Transpose(student_range.Value) 'row to column
Rows(First + 1 & ":" & Last).EntireRow.Delete
Skip: 'delete repeated entries
First = First + 1
Next i
Break:
End Sub
I've just created a brand new macro. Took function down below from internet (all credits goes to trumpexcel.com), code down below
Function CONCATENATEMULTIPLE(Ref As Range, Separator As String) As String
Dim Cell As Range
Dim Result As String
For Each Cell In Ref
Result = Result & Cell.Value & Separator
Next Cell
CONCATENATEMULTIPLE = Left(Result, Len(Result) - 1)
End Function
Then I proceed to extract data from various columns and into the one (my table is 20 rows x 10 columns)
Sub conact_data()
Dim i As Integer
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(i, "M").Value = Cells(i, "A").Value & " " & _
Cells(i, "B").Value & " / " & Cells(i, "D").Value & "; "
Next i
End Sub
Thanks to that I've got combined data from column A, B and D, so its 20 rows. All I want to do now is to concatenate data from M2:M21 using CONCATENATEMULTIPLE function therefore I try various approach (I want this huge line in P2 cell) like :
Cells(2, 16).Value = CONCATENATEMULTIPLE (M2:M21, " ")
or
Range("P2") = "CONCATENATEMULTIPLE (M2:M21, " ")"
I don't really know how to apply that
Secondly, I'd like withdraw the Cells(i, "B").Value as percentage. Can I do that in one line like Cells(i, "B").NumberFormat="0.00%".Value (which is not working for me obviously) else I need to copy column B into another column with number format and then combine the new column, properly formatted instead of column B?
Thanks in advance
Percent format: Range("B" & i).NumberFormat = "0.00%"
CONCATENATEMULTIPLE
In VBA, CHR(32) = " "
In Excel, CHAR(32) = " "
With that being said...
'Value
Range("P2").Value = CONCATENATEMULTIPLE(Range("M2:M21"), CHR(32))
'Formula
Range("P2").Formula = "=CONCATENATEMULTIPLE(M2:M21, CHAR(32))"
You should really qualify all of your ranges with a worksheet
Say your workbook has 10 sheets. When you say Range("P2"), how do we (VBE) know what sheet you mean? Objects need to be properly qualified. Sometimes this is not a huge issue, but when you are working across multiple sheets, not qualifying ranges can lead to some unexpected results.
You can qualify with a worksheet a few ways.
Directly: ThisWorkbook.Sheets("Sheet1").Range("P2").Copy
Or use a variable like so
Dim ws as Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
ws.Range("P2").Copy
Now there is no room for ambiguity (potential errors) as to the exact location of Range("P2")
First of all, remove your ConcatenateMultiple() code, and instead use Excel worksheet function CONCAT(), which takes a range and a delimiter as parameters.
Here is how you can handle the percentage issue and supply a default for non-numeric items. I've also cleaned up the way you reference your data range.
Sub concat_data()
Dim rngRow As Range, vResult As Variant
Const DEFAULT = 0 'Can also be set to a text value, eg. "Missing"
For Each rngRow In [A2].CurrentRegion.Rows
If IsNumeric(rngRow.Cells(, 4)) Then vResult = rngRow.Cells(, 4) * 100 & "%" Else vResult = DEFAULT
Range("M" & rngRow.Row) = rngRow.Cells(, 1) & rngRow.Cells(, 2) & "/" & vResult & ";"
Next
[M2].End(xlDown).Offset(1).Formula = "=CONCAT(M2:M" & [M2].End(xlDown).Row & ",TRUE,"" "")"
End Sub
I'm not a fan of hard-coding range references, like the [A2] or Range("M"), but will leave that for another time.
this is my first time using the site, so forgive me for any inept explaining. I have a working macro to hide/unhide rows based on content of the rows, I just want it to be faster. Using a check box, when the box is checked, all rows with an "x" in column D get unhidden, those without an "x" get hidden. Same thing happens when it is unchecked, except it references column C, not D.
Right now, this code works. It's just a little slower than I'd like, since I'm sharing this with a bunch of people. Any ideas for how to speed it up? I'm pretty darn new to VB (the internet is astoundingly wise and a good teacher), but that doesn't matter. I already improved the code - before it selected each row, then referenced the column, and it was awful. Any ideas to speed it up (preferably without moving the screen) would be great.
Thanks so much folks,
DS
Sub NewLuxCheck()
Dim x As Integer
NumRows = Range("A42", "A398").Rows.Count
Range("A42").Select
If ActiveSheet.Shapes("checkbox2").OLEFormat.Object.Value = 1 Then
For x = 42 To NumRows + 41 Step 1
If Worksheets("Base").Range("D" & x).Value = "x" Then
Worksheets("Base").Range(x & ":" & x).EntireRow.Hidden = False
Else
Worksheets("Base").Range(x & ":" & x).EntireRow.Hidden = True
End If
Next
Else
For x = 42 To NumRows + 41 Step 1
If Worksheets("Base").Range("C" & x).Value = "x" Then
Worksheets("Base").Range(x & ":" & x).EntireRow.Hidden = False
Else
Worksheets("Base").Range(x & ":" & x).EntireRow.Hidden = True
End If
Next
End If
MsgBox ("Done")
End Sub
You could use array formula and let Excel to return array with row-numbers where 'x' value occures. It will be quicker but you'll have to reorganise your code and create separate functions etc.
Here example where array formula finds rows whre in column 'D' the cell has value 'x'. Then string of this row numbers is created in form of "A1,A5,A10" ...means 'x' was found in rows 1,5,10. And finally Range(rowsJoind).EntireRow.Hidden is used for all the rows to be hidden/un-hidden in one step.
For rows with value different then 'x' you'll have to use formula like '=IF({0}<>""x"", ROW({0}), -1)'.
Sub test()
Dim inputRange As Range
Dim lastRow As Long
Dim myFormula As String
Dim rowsJoined As String, i As Long
Dim result As Variant
With Worksheets("Base")
lastRow = .Range("D" & .Rows.Count).End(xlUp).Row
Set inputRange = .Columns("D").Resize(lastRow)
Application.ReferenceStyle = xlR1C1
myFormula = "=IF({0}=""x"", ROW({0}), -1)"
myFormula = VBA.Strings.Replace(myFormula, "{0}", inputRange.Address(ReferenceStyle:=xlR1C1))
result = Application.Evaluate(myFormula)
result = Application.Transpose(result)
Application.ReferenceStyle = xlA1
For i = LBound(result) To UBound(result)
If (result(i) > -1) Then
rowsJoined = rowsJoined & "A" & result(i) & IIf(i < UBound(result), ",", "")
End If
Next i
.Range(rowsJoined).EntireRow.Hidden = False
End With
End Sub