This loops through each worksheet and inserts a VLOOKUP formula (which references a closed workbook). The code will start with the first sheet, find and open the corresponding workbook, and perform the VLOOKUP, then onto the next sheet/corresponding workbook. Everything works until I hit .Cells which is where i run into the Object error. What am I missing? I run this macro from the original workbook, then it opens the external workbook
For Each ws In ThisWorkbook.Worksheets
If (ws.Name <> "Sheet1") And (ws.Name <> "Sheet2") Then
Set wbPath2 = Workbooks.Open("C:\MyDirectory\MyFile1.csv")
sourceSheet = "[MySheet.csv]"
With ws
.Cells(Application.WorksheetFunction.Match("Account1", .Range("A:A"), 0), Application.WorksheetFunction.Match(ComboBox1.Value & " " & Year(Date), .Range("A6:BZ6"), 0)).Formula = "=VLOOKUP(""Account1 Service"",'" & Root & sourceSheet & ws.Name & " " & monthNumber & "." & lastDay & "." & Format(Now(), "yy") & "'!$A:$G,4,FALSE)"
It turns out I forgot to concatenate something in my file path pointer. Thank you to #Jordan for the Debug tips.
the object seems to ComboBox1.Value .
In sheet code, it is possible to use combobox. But in module, it is not possible. So use obleObject and link cell. And get the cell value.
Dim ws As Worksheet
Dim obj As OLEObject
Dim strCombo As String
For Each ws In ThisWorkbook.Worksheets
If (ws.Name = "Sheet1") Or (ws.Name = "Sheet2") Then
Else
Set wbPath2 = Workbooks.Open("C:\MyDirectory\MyFile1.csv")
sourceSheet = "[MySheet.csv]"
With ws
k = .Name
Set obj = .OLEObjects("ComboBox1")
obj.LinkedCell = "q1" 'your blank cell link ; this link "q1" cell
strCombo = .Range("q1")
.Cells(Application.WorksheetFunction.Match("Account1", .Range("A:A"), 0), Application.WorksheetFunction.Match(strCombo & " " & Year(Date), .Range("A6:BZ6"), 0)).Formula = "=VLOOKUP(""Account1 Service"",'" & Root & sourceSheet & ws.Name & " " & monthNumber & "." & lastDay & "." & Format(Now(), "yy") & "'!$A:$G,4,FALSE)"
.Range("q1").Clear
End With
End If
Next
Related
I am using Vlookup formula from another workbook in my code. The other workbook named as a variable TifuliWB Workbook but I keep getting an error run time error 1004. I am sure that it's such a small mistake of mine that stops the sub but I can't know what.
With MainWB.Worksheets(2)
LR = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("J2:J" & LR).FormulaR1C1 = _
"=VLOOKUP(RC[-8]," '"[" & TifuliWB.Worksheets(1) & "]"'"!C1:C71,65,FALSE)"
.Range("J2:J" & LR).NumberFormat = "m/d/yyyy"
.Cells.Copy
End With
Try referencing the columns' full external address instead of concatenating in the workbook and worksheet name.
.Range("J2:J" & LR).FormulaR1C1 = _
"=VLOOKUP(RC[-8]," & TifuliWB.Worksheets(1).range("A:BS").address(1, 1, external:=true, referencestyle:=xlr1c1) & ",65,FALSE)"
'alternately in xlA1 style
.Range("J2:J" & LR).Formula = _
"=VLOOKUP(J2," & TifuliWB.Worksheets(1).range("A:BS").address(1, 1, external:=true) & ",65,FALSE)"
Your original should have used the .Name or .FullName property and there were some string concatenation issues.
.Range("J2:J" & LR).FormulaR1C1 = _
"=VLOOKUP(RC[-8], '[" & TifuliWB.fullname & "]" & TifuliWB.Worksheets(1).name & "'!C1:C71,65,FALSE)"
Hello I have a little question for adding data to an existing chart.
Now I have a worksheet containing a data series with months for the years in the 2nd row of the sheet. So the months are for example B2 1.2017, C2 2.2017, and in the rows 3,4,5,6,7 and 8 there is always data for that month.
Now I just want my macro to add the new Month plus the data of the rows below to my existing chart.
the code I have so far is this:
Worksheets("Summary").ChartObjects("Chart").Activate
ActiveChart.SeriesCollection.Add _
Source:=Worksheets("Summary").Range("B2:B8")
now this does just create new data series but there is actually no new data added to the chart.
The code below might seem a little long, but it's the safest way to add a new Series with Data to an existing Chart.
I'm setting all the necessary Objects so the code will be as "safe-proof" as can be.
Code
Option Explicit
Sub AddSeriestoChart()
Dim ws As Worksheet
Dim ChtRng As Range
Dim ChtObj As ChartObject
Dim Ser As Series
' set the Worksheet object
Set ws = ThisWorkbook.Worksheets("Summary")
' Set the Chart Object
Set ChtObj = ws.ChartObjects("Chart")
' Set the Range of the Chart's source data
Set ChtRng = ws.Range("B2:B8")
With ChtObj
' add a new series to chart
Set Ser = .Chart.SeriesCollection.NewSeries
' set the source data of the new series
Ser.Values = "=" & ChtRng.Address(False, False, xlA1, xlExternal)
End With
End Sub
Edit 1: to modify existing Series data, use something like the code below :
With ChtObj
For i = 1 To .Chart.SeriesCollection.Count
Set Ser = .Chart.SeriesCollection(i)
' set the source data of the new series
Set ChtRng = ws.Range("B" & i + 2)
Ser.Values = "=" & ChtRng.Address(False, False, xlA1, xlExternal)
Set ChtRng = Nothing
Next i
End With
This is what I would use
wsMetric.ChartObjects("Chart").Chart
'This one will link data from another workbook
.SeriesCollection(1).Values = "='[" & wb.Name & "]" & ws.Name & "'!$" & sCol & "$" & lRow & ":$" & sCol2 & "$" & lRow2
'Debug.Print "='[" & wb.Name & "]" & ws.Name & "'!$" & sCol & "$" & lRow & ":$" & sCol2 & "$" & lRow2 'Returns ='[Book1.xlsm]Sheet1'!$A$1:$A$11
'This one will link data from the same workbook, same or different sheet
.SeriesCollection(1).Values = "=" & ws.Name & "!$" & sCol & "$" & lRow & ":$" & sCol2 & "$" & lRow 2
'Debug.print "=" & ActiveSheet.Name & "!$" & scol & "$" & lrow & ":$" & scol2 & "$" & lrow2 'Returns =Sheet1!$A$1:$A$11
End With
This doesn't use .Activate and directly accesses the chart
This is driving me absolutely insane.
I'm new to VBA and I compiled code line by line, adding more and more verifying it all worked within the same workbook using F8. The last bit I have to add is just opening a separate workbook, and now it's giving me errors each time. Here's my code:
Sub MasterXfer()
Dim mystring As String, wbName As String, dt As String, sdt As String, ldt As String
Dim wb1 As Workbook, wb2 As Workbook, mypath As String
wbNam = "Productivity "
dt = Sheet1.Range("B1").Value
sdt = Format(CStr(dt), "m.d.yy") & ".xlsx"
ldt = Format(CStr(dt), "yyyy") & "\" & Format(CStr(dt), "mm") & "_" & MonthName(Month(dt)) & "_" & Year(dt)
mypath = "S:\" & ldt & "\" & wbNam & sdt
Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open(mypath) 'HERE'S WHERE IT ERRORS OUT
With wb1
lastrow = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row
For x = 2 To lastrow Step 16
mystring = .Range("A" & x)
Stepping through this, it works fine. Then I get to the Set wb2 = Workbooks.Open line, and it successfully opens the target workbook, however immediately upon opening it the code stops and the error in question comes up.
If anyone at all can tell me what mistake I'm making I will name my firstborn after you.
Your error if caused by this line mystring = .Range("A" & x). Workbook does not have a Range method. You need to change it to wb1.Worksheets(1).
You should also test if the file exists before opening it.
I included an alternate method of creating your file string using the backslash to escape characters in the Format functions Format parameter.
Sub MasterXfer()
Dim wb2 As Workbook
Dim mypath As String
mypath = Format(Sheet1.Range("B1").Value, "\S:\\YYYY\\MM_MMMM_YYYY\\Pro\du\ctivit\y MM.DD.YY.xl\sx")
If Len(Dir(mypath)) = 0 Then
MsgBox "File not found" & vbCrLf & mypath
Stop
Exit Sub
End If
Set wb2 = Workbooks.Open(mypath)
With ThisWorkbook.Worksheets(1)
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For x = 2 To LastRow Step 16
mystring = .Range("A" & x)
Next
End With
End Sub
I am currently using the set value method to copy data from multiple workbooks. I can currently loop through all workbooks and set the values from one sheet, worksheet2(Title) as seen below, and copy them to "thisWorkbook" on "sheet1", my destination. How can I loop through worksheets 3 to 9 and copy the range A2:C57 into columns G,H,I using the same set value method?
Sub GetData()
Dim MyPath As String
Dim FileName As String
Dim SheetName As String
Dim NewRow As Long
MyPath = "C:\attach"
SheetName = "Title"
FileName = Dir(MyPath & "\*.xlsx")
Do While FileName <> ""
If FileName <> ThisWorkbook.Name Then
With ThisWorkbook.Sheets("Sheet1")
NewRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
With .Range("A" & NewRow)
.Formula = "='" & MyPath & "\[" & FileName & "]" & SheetName & "'!B4"
.Value = .Value
End With
With .Range("B" & NewRow)
.Formula = "='" & MyPath & "\[" & FileName & "]" & SheetName & "'!B5"
.Value = .Value
End With
With .Range("C" & NewRow)
.Formula = "='" & MyPath & "\[" & FileName & "]" & SheetName & "'!B6"
.Value = .Value
End With
With .Range("D" & NewRow)
.Formula = "='" & MyPath & "\[" & FileName & "]" & SheetName & "'!B7"
.Value = .Value
End With
With .Range("E" & NewRow)
.Formula = "='" & MyPath & "\[" & FileName & "]" & SheetName & "'!A1"
.Value = .Value
End With
With .Range("F" & NewRow)
.Formula = "='" & MyPath & "\[" & FileName & "]" & SheetName & "'!A2"
.Value = .Value
End With
'Copy the range A2:C57 from workheets (3 to 9) and past into columns G,H,I in thisworkbook from every workbook in folder.
'For sheets 3 to 9 set the value range A2:C57 to G,H,I in thisworkbook. This would be done for every workbook in the folder
End With
End If
FileName = Dir
Loop
ThisWorkbook.Sheets("Sheet1").Columns.AutoFit
End Sub
I'm not entirely sure if this is what you're asking, but I think the range.copy is what you want.
To get the entire worksheet 3-9 you can use
' A2:C57 = Cells (2,1),Cells(57,3)
For Sheetindex= 3 to ThisWorkbook.Worksheets.Count
'Copy Worksheet 3 A2:C57
Set SourceRange = ThisWorkbook.WorkSheets(Sheetindex).Range(Cells(2,1),Cells(57,3))
' Paste it in Columns G,H,I starting in Row 1.
SourceRange.Copy (ThisWorkbook.Worksheets("Sheet1").Cells("G1"))
Next Sheetindex
I want to execute, if the workbook exists already then re- run it if not exists then create a workbook.
I have uniques values(x) and array(names). I need to compare them if both are equal if not it has to create a workbook with name of array(names) that not had in uniques values(x)
My code:
Sub mac()
Dim c as integer
Dim x as range
Dim s_AgingSCM as string
Dim Array_SCM_Aging as variant
Dim NewBook as workbook
Dim NewBook_SCM as workbook
Dim Master_workbook as workbook
Dim rngCopy_Aging as range
Dim rngFilter_Ws2 as range
For c = LBound(Array_SCM_Aging) To UBound(Array_SCM_Aging)
Set Master_workbook = ThisWorkbook
s_AgingSCM = Array_SCM_Aging(c, 1)
Set x = Master_workbook.Sheets("BASS").Range("AY" & c)
If x = s_AgingSCM Then
With rngFilter_Ws2
.AutoFilter field:=32, Criteria1:="<>(a) 0 - 360", Operator:=xlFilterValues
.AutoFilter field:=37, Criteria1:=s_AgingSCM, Operator:=xlFilterValues
Set rngCopy_Aging = .SpecialCells(xlCellTypeVisible)
.AutoFilter ' Switch off AutoFilter
End With
rngCopy_Aging.Copy NewBook.Worksheets("Aging Inventory").Cells(1, 1)
Application.DisplayAlerts = False
Else
Dim fso: Set fso = createObject("Scripting.FileSystemObject")
Dim folder: Set folder = fso.GetFolder("C:\")
Dim file, fileNames
Dim rngCopy_SCMAging As Range
For Each file In folder.Files
If Right(file.Name, 4) = "xlsx" Then
fileNames = fileNames & file.Name & ";" ' will give a list of all filenames
End If
Next
If InStr(fileNames, s_AgingSCM) = 0 Then
With NewBook_SCM
Set NewBook_SCM = Workbooks.Add
.Title = s_AgingSCM
NewBook_SCM.Worksheets("sheet1").Name = "Aging Inventory"
With rngFilter_Ws2
.AutoFilter field:=32, Criteria1:="<>(a) 0 - 360", Operator:=xlFilterValues
.AutoFilter field:=37, Criteria1:=s_AgingSCM, Operator:=xlFilterValues
Set rngCopy_SCMAging = .SpecialCells(xlCellTypeVisible)
.AutoFilter ' Switch off AutoFilter
End With
rngCopy_SCMAging.Copy Destination:=NewBook_SCM.Worksheets("Aging Inventory").Cells(1, 1)
.SaveAs Filename:="KPI" & " " & s_AgingSCM & " " & Format_date & ".xlsx"
Application.DisplayAlerts = False
NewBook_SCM.Close
End With
' Else
End If
End sub
I was stuck here since 2 days. All i want is if the workbook exists then overwrite with the new workbook or else if its not exists create a new workbook.
Can someone please help me out.
A quick way to do it would be placing: -
If fso.FileExists(Application.DefaultFilePath & "\KPI" & " " & s_AgingSCM & " " & Format_date & ".xlsx")
fso.DeleteFile Application.DefaultFilePath & "\KPI" & " " & s_AgingSCM & " " & Format_date & ".xlsx", True
End If
Above the line
.SaveAs Filename:="KPI" & " " & s_AgingSCM & " " & Format_date & ".xlsx"
But this would not account for if the file could not be deleted (i.e. already open)