How would I go about coding a function to effect a range of worksheets in excel? What I want to do is to check to see if the same worksheet name has been created and if it has I need to end the program, and if it hasn't then I need to copy and paste a template from the Template worksheet to the new sheet.
Private Sub Workbook_Open()
Dim Ldate As String
Dim Lweekday As Integer
Dim Newweek As String
Dim name As String
Ldate = Date
Worksheets(1).Range("A1").Value = Ldate
Lweekday = Weekday(Ldate)
If Lweekday = 4 Then
Newweek = DateAdd("d", 3, Ldate)
name = Month(Newweek) & "-" & Day(Newweek) & "-" & Year(Newweek)
Sheets.Add.name = name
Worksheets("Template").Select
Range("A1:U37").Copy Destination:=Sheets(name).Range("A1")
End If
End Sub
Do you mean that you want to affect a name to a range in VBA?
If that's it, here is the base to help you :
Dim RgToName as Range
RgToName = "=" & SheetName & "!R" & StartRow & "C" & StartColumn & _
":R" & EndRow & "C" & EndColumn
ActiveWorkbook.Names.Add Name:=RangeName, RefersToR1C1:=RgToName
Related
i would like to come up with vba sub that searching value from one specified cell (job) across all sheets and then pastes rows but only with selected columns. If value not found any error message instead paste value.
I know it's bigger project but I'm fresh so try to my best.
As far i have solution for whole rows:
Sub TEST()
Dim tws As String
Dim l_row As String
Dim l_rowR As String
Dim job As String
Dim i As Integer
Set tws = ThisWorkbook.Sheets("Data")
tws.Range("A20") = "STATS:"
job = tws.Range("B5")
lastRow = Worksheets("Sheet1").Range("E" & Rows.Count).End(xlUp).Row
lastRowRpt = tws.Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To lastRow
If Worksheets("Sheet1").Range("E" & i).Value = job And _
Worksheets("Sheet1").Range("D" & i).Value = "x2" Then
Worksheets("Sheet1").Rows(i).Copy
lastRowRpt = tws.Range("A" & Rows.Count).End(xlUp).Row
tws.Range("A" & lastRowRpt + 1).Select
tws.Paste
End If
Next i
End Sub
I have a single chart in an Excel 2016 workbook. The macro below should replace each of the eight series formulas' source sheets with the last eight sheets of a separate workbook. Trying to run it crashes excel, and does not modify the chart.
Sub ChangeSourceData()
Dim chartBook As Workbook
Dim dataBook As Workbook
Dim sheetNumber As Long
Dim cementID As String
Dim myChart As Chart
Dim mySeries As Series
Dim seriesNumber As Long
Set chartBook = ThisWorkbook
Set dataBook = Workbooks.Open(Filename:="S:\Current Projects\R&D\CalorimetryDataOPCAutomated.xlsx")
sheetNumber = dataBook.Worksheets.Count
seriesNumber = 1
For Each myChart In chartBook.Charts
For Each mySeries In myChart.SeriesCollection
cementID = dataBook.Worksheets(sheetNumber).Name
mySeries.Formula = "=SERIES('[CalorimetryDataOPCAutomated.xlsx]" & cementID & _
"'!$B$2,'[CalorimetryDataOPCAutomated.xlsx]" & cementID & _
"'!$B$4:$B$5000,'[CalorimetryDataOPCAutomated.xlsx]" & cementID & _
"'!$F$4:$F$5000," & seriesNumber & ")"
sheetNumber = sheetNumber - 1
seriesNumber = seriesNumber + 1
Next mySeries
Next myChart
End Sub
I have run this macro with the mySeries.Formula string assigned to a String variable test which I can Debug.Print just fine. I have tried to Set mySeries.Formula but it doesn't appear that's the correct way to modify the formula. I've tried mySeries.Formula = Replace(mySeries.Formula, mySeries.Formula, newFormula) which also causes a crash.
What am I doing wrong? Is there a better way to do this?
I was able to solve this by modifying each of the individual components, rather than the complete formula. I replaced:
cementID = dataBook.Worksheets(sheetNumber).Name
mySeries.Formula = "=SERIES('[CalorimetryDataOPCAutomated.xlsx]" & cementID & _
"'!$B$2,'[CalorimetryDataOPCAutomated.xlsx]" & cementID & _
"'!$B$4:$B$5000,'[CalorimetryDataOPCAutomated.xlsx]" & cementID & _
"'!$F$4:$F$5000," & seriesNumber & ")"
seriesNumber = seriesNumber + 1
with:
With mySeries
.Name = dataBook.Worksheets(sheetNumber).Name
.Values = dataBook.Worksheets(sheetNumber).Range("F4:F5000")
.XValues = dataBook.Worksheets(sheetNumber).Range("B4:B5000")
End With
which now works perfectly.
Need you help on my macro
I try to vlookup from 2 difference workbook. 1 of my workbook will change name everyday as per date. I already get that part. Now I stuck how to Dim the variable workbook to use in vlookup formula. Here my code
I want to dim OCBReport.
Sub Part_ETA_PLANNER()
'
'Part ETA PLANNER Macro
'
'
'Find OCB PLanner Today
Dim OCBDaily As Workbook
Dim t As Workbook
For Each t In Workbooks
If Left(t.Name, 11) = "OCB_Report_" Then
Set OCBDaily = Workbooks(t.Name)
End If
Next t
'Variable Dim
Dim PartNumber, myRange As Long
Dim OCBReport As Sheets
Set OCBReport = "[ & OCBDaily & ]OCB" ' I got error on this part'
PartNumber = Range("L2").Offset(0, -10).Address(0, 0)
myRange = "'" & OCBReport & "'!C:W"
'Vlookup Part ETA planner
Dim LastRow As Long
LastRow = Sheets("Unfulfilled Daily Report").Range("E" & Rows.Count).End(xlUp).Row
Sheets("Unfulfilled Daily Report").Range("L2").Formula = "=VLOOKUP(" & PartNumber & "," & myRange & ", 21, FALSE)"
Sheets("Unfulfilled Daily Report").Range("L2").AutoFill Destination:=Range("L2:L" & LastRow)
Sheets("Unfulfilled Daily Report").Range("L2:L" & LastRow).Copy
Sheets("Unfulfilled Daily Report").Range("L2:L" & LastRow).PasteSpecial xlPasteValues
Range("B2").Select
End Sub
What you need is a String variable. Also if you put a variable within quotes then it will behave like a string. Also OCBDaily.Name will give you the workbook name which you can encase in "[]"
Change
Dim OCBReport As Sheets
Set OCBReport = "[ & OCBDaily & ]OCB" ' I got error on this part'
to
Dim OCBReport As String
OCBReport = "[" & OCBDaily.Name & "]OCB"
If I understand your part of code correctly, you need to change it to:
Set OCBReport = OCBDaily.worksheets("OCB")
Your attempt tries to set the sheet variable to a string, which give should give an type error. 'OCB' should be the name of the wanted worksheet.
Greetings,
Krossi
I have vba script which apply vlookup from one excel file another file. Its work fine but the output excel file only contains output data but i need formula for that vlookup output because i need apply same thing next by using copy paste so i need a help to get formula also in output excel. This my vba script
Sub vloo()
Dim rng As Range
Dim user As String
Dim file As String
Dim n As Integer
Dim m As Integer
Dim c As Integer
Dim a As Variant
n = 1
m = 0
c = 2
file = "E:\output8.xls"
Workbooks.Add
ActiveWorkbook.SaveAs file
Set nb = Application.Workbooks.Open(file)
Set ns = nb.Worksheets("Sheet1")
'get workbook path
filename = Application.GetOpenFilename(FileFilter:="Excel Files (*.xlsx), *.xls", Title:="Please select a file")
'set our workbook and open it
Set wb = Application.Workbooks.Open(filename)
'set our worksheet
Set ws = wb.Worksheets("Sheet1")
'set the range for vlookup
Set rng = ws.Range("F:AI")
For y = 6 To 20
m = m + 1
user = MsgBox(ws.Cells(1, y), 4, "You Want This")
If user = 6 Then
ns.Cells(1, n) = ws.Cells(1, y)
ns.Cells(1, n).Interior.Color = vbYellow
n = n + 1
If m > 1 Then
ns.Cells(2, c).Value = Application.VLookup(ns.Cells(2, 2).Value, rng, m, False)
c = c + 1
End If
End If
Next
End Sub
After execute this script and went to output excel ns and press F2 in each entry but getting only data dont know why formula are not there so i need formula also.
Simply alter your script so that it writes the formula rather than the evaluation thereof:
Change this:
ns.Cells(2, c).Value = Application.VLookup(ns.Cells(2, 2).Value, rng, m, False)
To this (revised to fully qualify the range used in the VLookup's third argument):
ns.Cells(2, c).Formula = "=VLookup(" _
& ns.Cells(2, 2).Value & "," _
& "[" & rng.Parent.Parent.Name & "]'" & rng.Parent.Name & "'!" & rng.Address & "," _
& m & "," _
& "False)"
If you debug, assuming I did not make any typos, then the that should have the third argument like so:
[Mains_heet_for_SEA_October14.xlsx]'Sheet1'!$F$2:$M$2
Note this may slow down the macro since formulas may re-evaluate during runtime. There are ways around this using the Application.Calculation property if that becomes an issue.
UPDATE
You can verify this works in principle with a Debug statement. Put it in it's own procedure if you'd like, and test it out like so:
Sub foo()
Dim rng As Range
Dim m As Integer
m = 3
Set rng = Range("A1:D10")
Debug.Print "=VLookup(" _
& "some_value" & "," _
& "[" & rng.Parent.Parent.Name & "]'" & rng.Parent.Name & "'!" & rng.Address & "," _
& m & "," _
& "False)"
End Sub
Here is proof that this works:
This code is to open files and go to a certain sheet, grab everything from A11 to AC(down), go back to a report and progressively paste it one after the other, which works with the exception that it can't find the next available row so it pastes the new data over the previous data. I am quite sure that my efforts with LastRowSrce and LastRowDest is the culprit but I can't get it right. I saw some posts with UsedRange so I tried that but couldn't get it right either.
Any help greatly appreciated.
Sub CSReport()
Dim y As Long
Dim Wkb As Workbook
Dim Wks As Worksheet
Dim SFile As String 'srce file
Dim GWB As String 'dest file
Dim R1 As Range
Dim R2 As Range
Dim LastRowSrce As Long 'find last row in srce file
Dim LastRowDest As Long 'find last row in dest file
Set Wkb = thisWorkBook
Set Wks = Wkb.Worksheets("CS Report")
Wks.Range("A11:AD10000").ClearContents
Wks.Range("A4").value = "Status at " & Time & " " & Format(Date, "Long date")
y = 11 'start row
SFile = Wkb.Path & "\"
GWB = Dir(SFile & "*Audit*")
Do While Len(GWB) > 0
workbooks.Open fileName:=SFile & GWB
LastRowSrce = workbooks(GWB).Worksheets("Audit Plan").Cells(Rows.Count, "A").End(xlUp).Row
LastRowDest = Wks.Cells(Rows.Count, "A").End(xlUp).Row + 1
Set R1 = workbooks(GWB).Worksheets("Audit Plan").Range("A" & y & ":AB" & LastRowSrce)
Set R2 = Wks.Range("A" & y & ":AB" & LastRowSrce)
R2.value = R1.value
workbooks(GWB).Close False
y = y + 1
GWB = Dir
Loop
Wkb.Save
End Sub
Set R2 = Wks.Range("A" & y & ":AB" & LastRowSrce)
you keep setting the same range on the destination sheet... you need it to be dynamic.
set R2 = Wks.Range("A" & LastRowDest & ":AB" & LastRowDest+LastRowSrce-11)
try that...