At some point I need to consolidate data (simply sum duplicated items). I would like to parameterize Sources:= argument - actually everything works the way I amused when using option after single quote mark. When using src variable I'm getting: Cannot open consolidation source file (picture attached). Looking forward for some tips.
Here is the code:
Sub Format()
' Keyboard Shortcut: Ctrl+Shift+C
'Definition
Dim wb As Workbook
Dim ws As Worksheet
Dim rg As Range
Dim lRow As Integer
Dim src As String
Set wb = ActiveWorkbook
Set ws = ThisWorkbook.ActiveSheet
'Format data
Range("H2").Select
ActiveCell.FormulaR1C1 = "=RC[-5]&""*""&RC[-4]&""*""&RC[-3]&""*""&RC[-2]"
Range("I2").Select
ActiveCell.FormulaR1C1 = "=RC[-7]"
' Find the last non-blank cell in column B(2)
lRow = Cells(Rows.Count, 2).End(xlUp).Row
Set rg = Range("H2", Cells(lRow, 9))
' AutoFill of formated data
Range("H2:I2").Select
Selection.AutoFill Destination:=rg, Type:=xlFillDefault
'Consolidate
src = """" & "'" & wb.Path & "\[" & wb.Name & "]" & ws.Name & "'!R2C8:R" & lRow & "C9" & """"
Debug.Print src
'Range("K2").Consolidate Sources:= _
"'C:\Users\pl1aji0\Documents\Projekty\USA\2020\L034.00080 Innovation\700\BPM\[test.xlsx]Sheet1'!R2C8:R11C9" _
, Function:=xlSum, TopRow:=False, LeftColumn:=True, CreateLinks:=False
Range("K2").Consolidate Sources:= _
src _
, Function:=xlSum, TopRow:=False, LeftColumn:=True, CreateLinks:=False
End Sub
Related
Anyone,
I'm trying to make a program in excel vba in which the macro would look/loop for the sheet name in the workbook base on the excel range. Also, after looking for the sheet name, the program would save the sheet based on the given file name on the other cell range.
My main problem here is on how I can save the loop file/sheet name based on the teritory name given in the picture provided below.
Hope you can help me with my problem.
Here's my recent work on the macro, I can save the file but it saves the file based on the sheet name I have looked up. Thanks.
sample picture here
Sub Save_Test()
Dim ws As Worksheet
Dim wb As Workbook
Dim c, b As Range
Dim rng, rng2 As Range
Dim mysheet As Worksheet
Dim LastRow, LastRow2 As Integer
Dim file_name As String
LastRow = Range("I" & rows.Count).End(xlUp).row
Set rng = Range("J5:J" & LastRow)
Set ws = Worksheets("Control")
For Each c In rng
Sheets(c.Value).Select
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Application.DisplayAlerts = False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
ActiveSheet.Name = c.Value
Application.CutCopyMode = False
ActiveWindow.DisplayGridlines = False
TemplateLocation = ThisWorkbook.Path
file_name = c.Value
ActiveWorkbook.SaveAs Filename:=TemplateLocation & "\" & "Reports" & "\" & Format(Now() - 1, "mmyy") & " " & file_name & " Hustle Board thru " & Format(Now() - 1, "mm-dd-yy"), FileFormat:=51, CreateBackup:=False
Application.DisplayAlerts = False
ActiveWindow.Close
Next
Sheets("Control").Select
End Sub
You will have to fill in the other stuff you need to do, but going off your picture and you code, this should get you the value in the teritory column
Dim r As Range
Dim rng As Range
Dim LastRow As Long
Dim ws As Worksheet
LastRow = Range("I" & Rows.Count).End(xlUp).Row
Set rng = Range("J5:J" & LastRow)
For Each r In rng
file_name = r.Offset(, -1)
ActiveWorkbook.SaveAs Filename:=TemplateLocation & "\" & "Reports" & "\" & Format(Now() - 1, "mmyy") & " " & file_name & " Hustle Board thru " & Format(Now() - 1, "mm-dd-yy"), FileFormat:=51, CreateBackup:=False
Next r
End Sub
BTW, if you did not already know, declaring varibales like this below is not good practice.
Dim rng, rng2 As Range
In this case rng is not a rng at this point. You need to do this below to explicitly declare as a Range variable.
Dim rng as Range, rng2 As Range
I have looked at many posts and cannot seem to get this right. I have a userform that take a codename and then creates a sheet with that name, then adds a link to the new sheet as the last cell in Column B on another sheet. I have used 3 different methods to insert the hyperlink, but all of them just return a blank cell, while if I change the value to any string, it works.
Dim sh As Worksheet
Dim codename As String
Dim lastrow As Long
Dim cont As Worksheet
On Error Resume Next
Application.ScreenUpdating = False
codename = InputBox("What is the codename?")
Sheets("XXX").Visible = True
Sheets("XXX").Copy After:=Worksheets("YYY")
ActiveWindow.ActiveSheet.name = codename
Sheets("XXX").Visible = False
Worksheets(YYY).Activate
lastrow = Sheets("YYY).Range("B" & Rows.Count).End(xlUp).Row + 1
ActiveSheet.Range("B" & lastrow).End(xlUp).Offset(1).Hyperlinks.Add Anchor:=ActiveCell, Address:="", SubAddress:=sh & "!A1", TextToDisplay:=codename
ActiveSheet.Range("B" & lastrow).End(xlUp).Offset(2).Activate
ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, Address:="", SubAddress:=sh.name & "!A1", TextToDisplay:=codename
ActiveSheet.Range("B" & lastrow).End(xlUp).Offset(3) = codename
ActiveSheet.Range("B" & lastrow).End(xlUp).Offset(4).Hyperlinks.Add Anchor:=Sheets(codename).Cells(1, 1), _
Address:="", SubAddress:=sh, TextToDisplay:=codename
Application.ScreenUpdating = True
I know I have 4 iterations of essentially the same thing. The point is is that no matter if I use 1 of them, or all 4, I get 3 blank cells and (codename) as plaintext, showing that I am obviously missing something easy that I for the life of me cannot figure out. Thanks to all responses.
The reason the links aren't working might be because you use the worksheet object sh without declaring it, and specifically, without declaring it as the new sheet.
In my solution I've only tested it using the .Add method that I included out-commented.
Sub test()
Dim sh As Worksheet, nsh As Worksheet ' sh = YYY, nsh = codename
Dim nrng As Range
Dim codename As String
Dim lastrow As Long
Dim cont As Worksheet
codename = InputBox("What is the codename?")
Set sh = Sheets("YYY")
Sheets("XXX").Visible = True
Sheets("XXX").Copy After:=Worksheets("YYY")
ActiveWindow.ActiveSheet.Name = codename
Sheets("XXX").Visible = False
'Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = codename ' if needed
sh.Activate
lastrow = sh.Range("B" & Rows.Count).End(xlUp).Row + 1
sh.Hyperlinks.Add _
Anchor:=sh.Range("B" & lastrow), _
Address:="", _
SubAddress:="'" & codename & "'!A1", _
TextToDisplay:=codename
End Sub
Shamelessly stolen from myself.
Sub Tester()
DoHyperlink Sheets("Sheet1").Range("F10"), _
Sheets("Sheet 2").Range("E12"), _
"Click Me"
End Sub
'assumes rngFrom and rngTo are in the same workbook...
Sub DoHyperlink(rngFrom As Range, rngTo As Range, LinkText As String)
rngFrom.Parent.Hyperlinks.Add Anchor:=rngFrom, Address:="", _
SubAddress:="'" & rngTo.Parent.Name & "'!" & rngTo.Address(), _
TextToDisplay:=LinkText
End Sub
If I get you right, you are trying to do this... But don't understand why it's "YYY" (not dynamic).
Option Explicit
Sub AddSheetAndLinkIt()
Dim codename As String
Dim oWS As Worksheet, oRng As Range
codename = InputBox("What is the codename?")
' Check if codename already exists
On Error Resume Next
Set oWS = ThisWorkbook.Worksheets(codename)
If Not oWS Is Nothing Then
MsgBox "The worksheet for """ & codename & """ already exists! You cannot create it again.", vbExclamation + vbOKOnly
Exit Sub
End If
' Copy worksheet "XXX" and add hyperlink to "YYY"
Set oWS = ThisWorkbook.Worksheets("YYY")
Set oRng = oWS.Range("B" & Rows.Count).End(xlUp)
ThisWorkbook.Worksheets("XXX").Copy After:=oWS
With ThisWorkbook.Worksheets("XXX (2)")
.Name = codename
.Visible = True
.Activate
End With
oWS.Hyperlinks.Add oRng, "", "'" & codename & "'!A1", "Go to " & codename, codename
Set oRng = Nothing
Set oWS = Nothing
End Sub
I want to make a link from active cell in workbook 1 which can I use it in workbook 2. I use the following code which assigned to a button:
With ActiveSheet
.Hyperlinks.Add Range("F6"), _
.Parent.FullName & "#'" & .Name & "'!" & "$A$1", TextToDisplay:="link"
End With
This code made a link with full path and I can use it in any workbook but I need some changes which I could to:
Make the active cell hyperlink not cell A1 which specified in code.
The value in the active cell become text to display arg of hyperlink function.
Thanks
PS after Vityata answere: how can i change Range("F6") to activecell adress?
In order to obtain the active cell value and address, change your code the corresponding places with the following:
ActiveCell.Address
ActiveCell.Value
I find it just to close this topic.
Sub Button36_Click()
Dim newRange As Range
Set newRange = Range(ActiveCell, ActiveCell.Offset(numRows, numCols))
With ActiveSheet
.Hyperlinks.Add Anchor:=newRange, _
Address:=.Parent.FullName & "#'" & .Name & "'!" & ActiveCell.Address, TextToDisplay:=ActiveCell.Text
End With
End Sub
try this
Sub add_links_Input_Column()
Dim lRow As Long
Dim ColHead As String
ColHead = InputBox("Enter Column Letter", "Identify Column", [c1].Value)
If ColHead = "" Then Exit Sub
With ActiveSheet
lRow = .Range(ColHead & .Rows.Count).End(xlUp).Row
For Each c In .Range(ColHead & "2:" & ColHead & lRow)
ActiveSheet.Hyperlinks.Add anchor:=c, Address:=c.Value
Next
End With
End Sub
I've never used VBA before, I don't know the commands and stuff. I really trying and I need some help please. I've to copy only the visible data from specified columns and paste to another worksheet, but I receive Subscript out of range error, while running the code. In the code I've to select the rows from the 7th row and I think I coded this a bit rough. Can anyone check my code why is this not working? Any suggestions for a better solution is appreciated.
Sub CopyData()
Windows("Source.xlsx").Activate
Range("D7, F7, G7, I7, J7, K7, L7, M7, O7, AD7, AX7, CO7, CQ7, CR7, AX7").Select
Range(Selection, Selection.End(xlDown)).Select
If Selection.EntireColumn.Hidden = False Then
Selection.Copy
End If
Windows("Destination.xlsx").Activate
Range("A2").Select
ActiveSheet.Paste
End Sub
Give this a shot:
Sub CopyData()
'set variables for wkb and ws to copy
Dim wbSource As Workbook
Set wbSource = Workbooks("Source.xlsx")
Dim wsCopy As Worksheet
Set wsCopy = wbSource.Worksheets("Sheet1") 'change name as needed
'set variables for wkb and ws to paste
Dim wbDest As Workbook
Set wbDest = Workbooks("Destination.xlsx")
Dim wsDest As Worksheet
Set wsDest = wbDest.Worksheets("Sheet1")
'copy visible cells for specific range
With wsCopy
Dim lRow As Long
lRow = .Range("D" & .Rows.Count).End(xlUp).Row
Dim rCopy As Range
Set rCopy = Union(.Range("D7:D" & lRow), .Range("F7:F" & lRow), _
.Range("G7:G" & lRow), .Range("I7:I" & lRow), .Range("J7:J" & lRow), _
.Range("K7:K" & lRow), .Range("L7:L" & lRow), .Range("M7:M" & lRow), _
.Range("O7:O" & lRow), .Range("AD7:AD" & lRow), .Range("AX7:AX" & lRow), _
.Range("CO7:CO" & lRow), .Range("CQ7:CQ" & lRow), .Range("CR7:CR" & lRow))
End With
'paste
rCopy.SpecialCells(xlCellTypeVisible).Copy wsDest.Range("A2")
End Sub
Dim rng As Range
Set rng = Application.Intersect(ActiveSheet.UsedRange, Range("A1:H500"))'range depends your work
Windows("Destination.xlsx").Activate
rng.SpecialCells(xlCellTypeVisible).Copy Destination:=Range("A2")
or you just use,
ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
without intersection method. Totally depends on your work.
I have built a code that performs a sumif on another workbook that I open using the get open filename dialogue box. I intend to use this formula daily, and hence the workbook where I intend to obtain the information and the workbook where I intend to paste the results will continue to have varying names basing on the date of the day.
I get a type mismatch on the SUMIF formula. Please help.
Sub flextab()
Dim LastCol As Integer, LastRow As Long
' Get the dimensions
With Sheets("Flex")
LastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
End With
'Insert a column where required.
Cells(2, LastCol - 1).EntireColumn.Insert
'Insert the date
Cells(2, LastCol - 1).Value = Date - 1
'Insert the balance sheet balances for the day
Dim wb1 As Workbook, wb2 As Workbook
Dim FileName1 As String, FileName2 As String
Dim BalSheet As Worksheet
Dim Ret1
FileName1 = ThisWorkbook.Name
'~~> Get the first File
Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
, "Please select the Balance sheet for the day")
If Ret1 = False Then Exit Sub
Set wb2 = Workbooks.Open(Ret1)
FileName2 = wb2.Name
Workbooks(FileName1).Activate
'let's get a reference to the worksheet with the source values
Set BalSheet = Workbooks(FileName2).Worksheets("Sheet1")
With Worksheets("Flex").Range(Cells(5, LastCol - 1), Cells(109, LastCol - 1))
'let's put in our SUMIF formulas
.Formula = "=SUMIF(" & BalSheet.Range("B2:B20000") & "," & Worksheets("Flex").Range("A5") & " , " & BalSheet.Range("n2:n20000") & ")"
'let's convert the formulas into values
.Value = .Value
End With
wb2.Close SaveChanges:=False
Set wb2 = Nothing
Set wb1 = Nothing
End Sub
You are adding ranges to a string, while ranges are objects. Try this:
"=SUMIF(" & BalSheet.Range("B2:B20000").Address & "," & Worksheets("Flex").Range("A5").Value & " , " & BalSheet.Range("n2:n20000").Address & ")"
instead of this:
"=SUMIF(" & BalSheet.Range("B2:B20000") & "," & worksheets("Flex").Range("A5") & " , " & BalSheet.Range("n2:n20000") & ")"
You are working with 2 workbooks, but you are using some worksheets without qualifier.
If you have focus to the wrong workbook this will fail if the workbook that is active does not have a Flex worksheet.
So change this:
Worksheets("Flex").Range(Cells(5, LastCol - 1)
to this:
wbX.Worksheets("Flex").Range(Cells(5, LastCol - 1)
where the X is the correct workbook.