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
Related
Let consider the following piece of code, where I inserted an Excel formula to perform a very simple count.
dim wb as Workbook
dim ws as Worksheet
dim ws_a as Worksheet
set wb = ThisWorkbook
set ws = wb.Worksheets("D")
set ws_a = wb.Worksheets("A")
With ws_a
.Range("c2").Formula = _
"ROWS(UNIQUE(FILTER(" & "D"! & Range("c2:c400").Address & "," & _
"IF(" & .Range("a2").Address(0,0) & " =""Empty"","""",""*""& " & .Range("a2").Address(0,0) & " &""*""))"
'following part of code
End With
As you can see, the Range in the Sheet "D" is not dynamic. I'd like to make it dynamic, taking into account the empty cells in the range. Basically, I would need to replace
Range("c2:c400")
with something like
D.Range("c2"),D.Cells(D.Range("c2").SpecialCells(xlCellTypeLastCell).Row, 3))
In the attempt of concatenating strings, I definitely get lost with & and "", so I think this is the problem: my poor knowledge of this type of syntax.
I've also tried to dim and set the range needed (outside the formula), but the code refers to the wrong sheet, as if it could not identify different sheets in the formula.
Dim wb as Workbook, ws as Worksheet, ws_a as Worksheet
Set wb = ThisWorkbook: Set ws = wb.Worksheets("D"): Set ws_a = wb.Worksheets("A")
Dim rngFilter as Range: Set rngFilter = ws_a.Range("c2:C400")
Set rngFilter = Range(rngFilter.Cells(1), rngFilter.SpecialCells(xlCellTypeLastCell))
With ws_a
.Range("c2").Formula = _
"ROWS(UNIQUE(FILTER(" & rngFilter.Address & "," & _
"IF(A2 =""Empty"","""",""*""& A2 &""*""))"
'following part of code
End With
I am trying to search for "Week #" (Number) within a different Workbook based on the row, once the correct Week has been found I want to copy values from this week and paste it into my Active Workbook. I can't seem to get this to work properly however.
I am able to open up the correct workbook so I know it is not an issue with the WeekFile variable. The WeekNumber variable is equal to a cell containing (example) "Week 39". Assume Range A contains all Week #s in the workbook I'm trying to grab data from.
Sub ImportTable()
Dim count As Integer
Dim WeekNumber As String
WeekFile = Sheets("Sheet1").Range("J3")
WeekNumber = Sheets("Sheet1").Range("O7")
SlideSheet = ActiveWorkbook.Name
count = 24
fi$ = "H:\Location\" & WeekFile
Workbooks.Open fileName:=fi$, ReadOnly:=True
DataSheet= ActiveWorkbook.Name
Do While Sheets("Sheet2").Range("A" & count) <> WeekNumber
If Sheets("Sheet2").Range("A" & count) = WeekNumber Then
Sheets("Sheet2").Range("B" & count & ":Q" & count).Copy
Workbooks(SlideSheet).Activate
Sheets("Sheet1").Range("P7:AE7").PasteSpecial xlValues
Exit Do
End If
count = count + 1
Loop
Workbooks(DataSheet).Close SaveChanges:=False
End Sub
This is a little easier to follow...
Dim FilePath As String
FilePath = "H:\Location\"
Dim WeekFile As String
WeekFile = ThisWorkbook.Sheets("Sheet1").Range("J3").Text
Dim WeekNumber As String
WeekNumber = ThisWorkbook.Sheets("Sheet1").Range("O7").Value
Workbooks.Open Filename:=FilePath & WeekFile & ".xlsx", ReadOnly:=True
'use ".xls" extension if needed
Dim FndwkNbr As Range
Set FndwkNbr = ActiveWorkbook.Worksheets("Sheet2").Columns(1).Find(What:=WeekNumber, LookAt:=xlWhole, MatchCase:=False)
FndwkNbr.Offset(, 1).Resize(, 16).Copy Destination:=ThisWorkbook.Sheets("Sheet1").Range("P7")
End Sub
I'm new here and to vba in general. I basically just read myself into the matter for my new job. So please bear with me.
I'm looking for a solution to my issue and found seperate solutions for parts but I'm not able to piece them together.
My goal is the following:
Copy 3 Worksheets of a workbook to a new one (not existing yet) and save it under the current date with a specific name.
Here's the code that I put together so far for that which works fine.
Sub export()
Dim path As String
Dim file As String
Dim ws As Worksheet
Dim rng As Range
path = "D:\#Inbox\"
file = Format(Date, "YYYY-MM-DD") & " " & Format(Time, "hhmm") & " " & "accr " & Format(DateSerial(Year(Date), Month(Date), 1), "YYYY_MM") & " city" & ".xlsx"
Application.ScreenUpdating = False
Sheets(Array("Accr", "Pivot", "Segments")).Select
Sheets(Array("Accr", "Pivot", "Segments")).Copy
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
For Each ws In Worksheets
ws.Rectangles.Delete
Next
Sheets(Array("Pivot", "Segments")).Visible = False
ActiveWorkbook.SaveAs Filename:=path & file, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close
Sheets("Menu =>").Select
Range("C1").Select
End Sub
1st condition: the new workbook should not be created manually and opened first, but the macro should do that.
2nd condition: the 1st workbook should have autofilters selected and then only visible cells copied. Is that possible as a whole worksheet, or do I have to copy the cells and create a worksheet in the new workbook?
Here's the code for the filter
Sheets("Accr").Select
Reset_Filter
Selection.AutoFilter Field:=1, Criteria1:="12"
Selection.AutoFilter Field:=2, Criteria1:="booked"
Selection.AutoFilter Field:=35, Criteria1:="Frankfurt"
Set rng = Application.Intersect(ActiveSheet.UsedRange)
rng.SpecialCells(xlCellTypeVisible).Copy
3rd condition: the other two worksheets should be copied without formulas but with format. (That is included in the first code sample)
My problem is now, to piece everything together so that there are 3 worksheets in the new workbook containing in the first ws the visible cells of the source ws with the autofilter and the other two worksheets containing only the data and the format and being hidden.
Info to my reasoning: the first worksheet refers with the formulas to the other two worksheets so that the recipients of the file have preselected fields and lists to fill out the cells.
Thank you very much in advance.
EDIT: Background Info:
The Accr sheet contains accrual informattion and has the Month information in column A. Since several years should be also able to be compared in one Pivot Table later on, the format was changed from a mere number to a date (format: MM.YYYY).
Edit
Alright, here is a different code, this copies the worksheets then removes the rows in Accr which do not meet the criteria. Be sure to make ranges absolute, put $ in front of the column and row in a formula, the vlookup you mentioned should become =VLOOKUP(R2097;Segments!$G:$Q;11;0) and this goes for any formula on the Accr sheet that references a fixed range anywhere.
Sub Export()
Dim NewWorkbook As Workbook
Dim Ws As Worksheet
Dim fPath As String, fName As String
Dim i As Long
Dim RowsToDelete As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set NewWorkbook = Workbooks.Add
fPath = "D:\#Inbox\"
fName = VBA.Format(VBA.Date, "YYYY-MM-DD") & " " & VBA.Format(VBA.Time, "hhmm") & " " & "accr " & VBA.Format(VBA.DateSerial(VBA.Year(VBA.Date), VBA.Month(VBA.Date), 1), "YYYY_MM") & " city"
NewWorkbook.SaveAs fPath & fName, xlOpenXMLWorkbook
ThisWorkbook.Worksheets(Array("Accr", "Pivot", "Segments")).Copy NewWorkbook.Worksheets(1)
For Each Ws In NewWorkbook.Worksheets
With Ws
If Not .Name = "Accr" And Not .Name = "Pivot" And Not .Name = "Segments" Then
.Delete
ElseIf Ws.Name = "Accr" Then
For i = 4 To .Cells(.Rows.Count, 1).End(xlUp).Row
If Not .Cells(i, 1) = .Cells(i, 1) = Month(ThisWorkbook.Worksheets("Mon").Cells(19, 2)) And Not .Cells(i, 2) = "booked" And Not .Cells(i, 35) = "Frankfurt" Then
If RowsToDelete Is Nothing Then
Set RowsToDelete = .Rows(i).EntireRow
Else
Set RowsToDelete = Union(RowsToDelete, .Rows(i).EntireRow)
End If
End If
Next i
If Not RowsToDelete Is Nothing Then
RowsToDelete.Delete xlUp
End If
ElseIf .Name = "Pivot" Or .Name = "Segments" Then
.Visible = xlSheetHidden
.UsedRange = Ws.UsedRange.Value
End If
End With
Next Ws
NewWorkbook.Save
NewWorkbook.Close
Application.Goto ThisWorkbook.Worksheets("Menu =>").Cells(1, 3)
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
End of edit
Ok... so after fiddling around with it a while and collecting several pieces of information around this website, I finally have a solution.
The main problem, was the first criteria, which is a date field. I found out that vba has its problems when the date is not in US-Format. So I made a workaround and made a textformat date in my parameter worksheet, so that I always have the export of the sheets for the current month set in the workbook.
In my accruals-data I just had to change the format in column A to have text (e.g. '01.2016).
Plus I optimized my rawdata a little bit, so that I only have to export one additional worksheet, which will be hidden and contains only hardcopy values, so that there is no external link to my original file anymore.
Sub ACTION_Export_AbgrBerlin()
Dim Pfad As String
Dim Dateiname As String
Dim ws As Worksheet
Dim oRow As Range, rng As Range
Dim myrows As Range
' define filepath and filename
Pfad = "D:\#Inbox\"
Dateiname = Format(Date, "YYYY-MM-DD") & " " & Format(Time, "hhmm") & " " & "Abr " _
& Format(DateSerial(Year(Date), Month(Date), 1), "yyyy-mm") & " Berlin" & ".xlsx"
Application.ScreenUpdating = False
Sheets(Array("Abgr", "Masterdata MP")).Copy
' hardcopy of values
Sheets("Masterdata MP").UsedRange = Sheets("Masterdata MP").UsedRange.Value
' delete Macrobuttons and Hyperlinks
For Each ws In Worksheets
ws.Rectangles.Delete
ws.Hyperlinks.Delete
Next
' delete first 3 rows (that are placeholders for the macrobuttons in the original file)
With Sheets("Abgr")
.AutoFilterMode = False
.Rows("1:3").EntireRow.Delete
' set Autofilter matching the following criteria
.Range("A1:AO1048576").AutoFilter
'refer to parameter worksheet which contains the current date as textformat
.Range("A1:AO1048576").AutoFilter Field:=1, Criteria1:=ThisWorkbook.Worksheets("Mon").Range("E21")
.Range("A1:AO1048576").AutoFilter Field:=2, Criteria1:=Array(1, "gebucht")
.Range("A1:AO1048576").AutoFilter Field:=36, Criteria1:=Array(1, "Abgr Berlin")
End With
'delete hidden rows i.e. delete anything but the selection
With Sheets("Abgr")
Set myrows = Intersect(.Range("A:A").EntireRow, .UsedRange)
End With
For Each oRow In myrows.Columns(1).Cells
If oRow.EntireRow.Hidden Then
If rng Is Nothing Then
Set rng = oRow
Else
Set rng = Union(rng, oRow)
End If
End If
Next
If Not rng Is Nothing Then rng.EntireRow.Delete
Sheets("Masterdata MP").Visible = xlSheetHidden
Sheets("Masterdata MP").UsedRange = Sheets("Masterdata MP").UsedRange.Value
ActiveWorkbook.SaveAs Filename:=Pfad & Dateiname, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close
'go back to main menu in original workbook
Sheets("Menu").Select
End Sub
Now I can create one sub for each file I have to create and then run all the subs after each other. That saves me a bunch of time.
The part with the hidden rows, I found here Delete Hidden/Invisible Rows after Autofilter Excel VBA
Thanks again #silentrevolution for your help, it gave me the pointers to get the needed result.
It's not the cleanest code and I'm sure that it can be made a bit leaner, so I would appreciate any recommendations. But for now it serves my needs.
I looked around on the forum, but could not find enough information to succeed. Appreciate your help throughout the process.
The top portion seems to work, but when I get to range.formula section, it doesn't work. I'm trying to reference to a sheet with variable name, then fill down the formula. To make sure formula goes all the way to the bottom, I refer it to column C as it will always have data without blanks.
Sub SubName()
If (Worksheets("Master Data").AutoFilterMode And _
Worksheets("Master Data").FilterMode) Or _
Worksheets("Master Data").FilterMode Then
Worksheets("Master Data").ShowAllData
End If
Dim curDate As String, Fname As String
curDate = Format(Date, "yyyy-mm-dd")
Dim wba As Workbook
Fname = "Y:\Consumables\Company\ABC\DMC - Planning & Materials\On Hand Reports\ABC Site\" & _
curDate & "_INV_R12_ABC_Onhandreport.xlsx"
Set wba = Workbooks.Open(Filename:=Fname, UpdateLinks:=False, Notify:=False)
Dim wb As Workbook
For Each wb In Application.Workbooks
If wb.Name Like "*PFEP*" Then wb.Activate
Next wb
Sheets("Master Data").Select
Range("AL8:AL" & Cells(Rows.Count, "C").End(xlUp).Row).Formula = _
"=SUMIF('[" &_INV_R12_ABC_Onhandreport.xlsx & "]Sheet'!C2,RC[-35],'[" & INV_R12_ABC_Onhandreport.xlsx & "]Sheet'!C17)"
End Sub
From what I see, you have too many quote symbols. Try this:
Range("AL8:AL" & Cells(Rows.Count, "C").End(xlUp).Row).Formula = _
"=SUMIF('[_INV_R12_ABC_Onhandreport.xlsx]Sheet'!C2,RC[-35],'[INV_R12_ABC_Onhandreport.xlsx]Sheet'!C17)"
Let me know if it helps.
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