I have a problem with my hyperlink in excel. Im trying to set a hyperlink from one sheet to another but the source and target cell needs to change every time in the loop. Basically i want to move data from one cell in GROUP 1 to another cell in GROUP 2 then set a hyperlink from GROUP 2 back to the same cell in GROUP 1. I have like 200 values so i want to do this in a loop. I just can´t figure out whats wrong whit my SubAddress!!
This is my code below.....
Thank you for any help.
Sub Transfer_and link()
Dim i As Integer
Dim LastRow1, As Long
LastRow1 = Sheets("GROUP 1").Cells(Rows.Count, "A").End(xlUp).Row
a = 14
For i = 5 To LastRow1 Step 2
Sheets("GROUP 2").Cells(a, 2) = Sheets("GROUP 1").Cells(i, 1)
Sheets("GROUP 2").Cells(a, 3) = Sheets("GROUP 1").Cells(i, 9)
Sheets("GROUP 2").Cells(a, 4) = Sheets("GROUP 1").Cells(i, 10)
Sheets("GROUP 1").Activate
Cells(i, 1).Select
Worksheets(2).Hyperlinks.Add Anchor:=Worksheets(2).Cells(a, 2), Address:="", _
SubAddress:=ActiveCell.Address
a = a + 1
Next i
ActiveCell.Address only returns the cell reference. You need to add the sheet reference too.
It'd be something like:
SubAddress:=ActiveCell.Worksheet.Name & "!" & ActiveCell.Address
If your sheet name may have a space like yours, it'd actually have to be this:
SubAddress:="'" & ActiveCell.Worksheet.Name & "'!" & ActiveCell.Address
Related
Some background: Each month I build a pivot table that has approx 30 or so business units (along the y axis) - lets call them groups. Each group has a number of GL accounts that change month to month. For example, Group 14 might have 10 GL accounts one month than the next have only 3. For each group, we need the summation of the totals for the GL accounts (that start with PL203000 & PL211010) for each group. Before we had to total these GL accounts for each group by hand. This has been solved with the code I have displayed below.
The code works perfectly when each group has more than one GL account (See pic 1)
The problem I am facing is when there is only one GL account, the code doesn't sum the correct amounts (see 2nd pic).
When digging into my code, you can see that it is summing the incorrect sections since i have a Rows.Count.End(xlUp) establishing the range. If there is only one GL account, it skips to the next section thereby establishing an incorrect formula
Perhaps my code needs to be completely revamped in order to account for groups where there is only one GL account to sum? If so, what sort of if statement can i code where it ignores groups that have only one GL account?
If not, than is the solution to have VBA count the range and if it is less than 3, ignore group and move on to the next?
'this section spits out the values needed to sum
For i = nRowMax To 4 Step -1
If Left(Cells(i, 1), 8) = "PL211010" Or Left(Cells(i, 1), 8) = "PL203000"
Then
Cells(i, 4).Copy
Cells(i, 5).PasteSpecial xlPasteValues
Range(Cells(i, 1), Cells(i, 4)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next i
Application.CutCopyMode = False
'this section uses the values the first section specified to write the sum formula
'i believe the macro uses this section of code to write the first formula and the next section of code writes the formulas for the rest of the groups
Dim firstRow As Variant
Dim finalRow As Variant
finalRow = Range("E" & Rows.Count).End(xlUp).Row
firstRow = Cells(finalRow, 5).End(xlUp).Row
If IsNumeric(Cells(finalRow + 1, 5)) Then
Cells(firstRow, 6).Formula = "=SUM(D" & firstRow & ":D" & finalRow & ")"
End If
'this section goes through the whole sheet to sum each group
For y = firstRow To 5 Step -1
finalRow = Cells(y, 5).End(xlUp).Row
firstRow = Cells(finalRow, 5).End(xlUp).Row
If firstRow < 5 Then firstRow = 5
If IsNumeric(Cells(finalRow + 1, 5)) Then
Cells(firstRow, 6).Formula = "=SUM(D" & firstRow & ":D" & finalRow &")"
End If
y = firstRow
'If firstRow = 5 Then Exit Sub
Next y
If your dataset is an accurate enough example, you can scan through your business units and pick out only what you need. I have some example code here that will build up your sum range by using the Union function and applying that to the SUM formula when the entire business unit has been scanned. Of course, this is only an example that fits the data shown. You'll have to expand it to fit situations that are not visible to me.
To simplify the logic, I've separated the code into a function that will start scanning rows for a business unit and will stop when it reaches the end of the business unit -- the test I'm using for detecting the start of the next BU is a line that does not start with "PL". This may or may not be correct for all your data.
Because this code is checking each line and accumulating the sum range using the Union, if you only have one cell, you'll still get a formula that says =SUM($D$30) but it works.
Option Explicit
Sub test()
Dim dataArea As Range
Set dataArea = ActiveSheet.Range("A1")
Do While Not IsEmpty(dataArea.Cells(1, 1))
Set dataArea = AddSums(dataArea)
Loop
End Sub
Private Function AddSums(ByRef businessUnitStart As Range) As Range
'--- loops through cells following the 'Start' range given,
' and accumulates the range of accounts to summarize
' RETURNS the start of the next business unit range
Dim accountRow As Range
Dim account As String
Set accountRow = businessUnitStart.Offset(1, 0)
Dim sumArea As Range
Do While Left$(accountRow.Cells(1, 1).Value2, 2) = "PL"
account = accountRow.Cells(1, 1).Value2
If (Left$(account, 8) = "PL211010") Or (Left$(account, 8) = "PL203000") Then
'--- add this account to the sum formula
If sumArea Is Nothing Then
Set sumArea = accountRow.Cells(1, 4)
Else
Set sumArea = Union(sumArea, accountRow.Cells(1, 4))
End If
End If
Set accountRow = accountRow.Offset(1, 0)
Loop
If Not sumArea Is Nothing Then
Dim accountSum As Range
Set accountSum = businessUnitStart.Offset(1, 6)
accountSum.Formula = "=SUM(" & sumArea.Address & ")"
End If
Set AddSums = accountRow
End Function
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.
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!
I am trying to write a code for filtering data with particular criteria and selecting filtered data, copy and pasting visible cells only in different sheet. However, I am getting error "Run time error 1004" stating MS Office excel can not create or use the data range because it is too complex.
enter image description here
below is the code that I am using
Set mwb = ActiveWorkbook
fname = ActiveWorkbook.Name
pth = path
period = Sheets("DEF").Range("F18").Value
ddate = Range("L6").Value
Sheets("MacroTOSplit").Select
blr = Range("C50").End(xlUp).Row
Rcfield = Range("C1").Value
For a = 4 To blr Step 1
Sheets("MacroTOSplit").Select
If Cells(a, "C").Value <> "" Then
rc1 = Cells(a, "C").Value
Sheets("XYZ").Select
Cells.AutoFilter
If lr >= 2 Then
Range("B2:B" & lr + 1).EntireRow.Delete
End If
Sheets("ABC").Select
dlr = lr
Set datarange = Sheets("ABC").Range(Cells(1, 1), Cells(dlr, "BG"))
'Filter for each unit and copy the data
datarange.AutoFilter Field:=Rcfield, Criteria1:=rc1, Operator:=xlFilterValues
datarange.Range(Cells(2, 1), Cells(dlr, "BG")).SpecialCells(xlCellTypeVisible).Copy Sheets("XYZ").Range("A2")
I am getting error at last step.
Please provide some solution for this.
Thanks,
Ravi
Try adjusting the last line to say:
datarange.Range(Cells(2, 1).address & ":" & Cells(dlr, "BG").address)
I think that you are out of luck if you get the range too complex message.
However, if it is possible, you could pre-sort your data so that the selection is in fewer non-contiguous blocks. This would make the selection less complex.
I have below piece of code to remove duplicates from a sheet by looking into two columns (column 3 & 5).
lRow = .Cells(Rows.Count, "A").End(xlUp).Row
'.Range("A1:BR" & lRow).RemoveDuplicates Columns:=Array(3, 5), Header:=xlYes
.Range("$A$1:$BR$" & lRow).RemoveDuplicates Columns:=Array(3, 5), Header:=xlYes
It works fine in Windows but unfortunately not on Mac.
Can anybody please suggest me what do I need to change here?
This piece of code will create a list of unique values and copy into another cell. So create unique list.
You have to specify where your list starts, and where you want to copy to. You can do this by changing the fromCell and toCell variables. I hope this helps.
Sub uniqueList()
fromCell = "A1"
toCell = "B1"
fromColumn = Mid(fromCell, 1, 1) 'This will resolve to A
toColumn = Mid(toCell, 1, 1) 'This will resolve to B
fromRow = Mid(fromCell, 2) 'This will resolve to 1
toRow = Mid(toCell, 2) 'This will resolve to 1
Dim cl As Range, UniqueValues As New Collection, uValue As Variant
Application.Volatile
numRows = Range(fromCell).End(xlDown).Row
On Error Resume Next
For Each cl In Range(fromCell & ":" & fromColumn & numRows)
UniqueValues.Add cl.Value, CStr(cl.Value)
Next cl
y = toRow - 1
For Each uValue In UniqueValues
y = y + 1
Range(toColumn & y) = uValue
Next uValue
End Sub
I think the answers to this are dated. I'm updating, in case someone else searches.
.removeduplicates works in Excel in mac. It should just be whatever your selection is and then .removeduplicates.
so this...
Range().RemoveDuplicates