Line 22 is throwing the error (Set wbPath2)
This code is supposed to loop through each worksheet in my workbook and, as it loops, open another workbook related to the current loop iteration, then sum a column, then put that SUM in my original workbook. I'm getting and object error 91. I've been scratching my head for a while. Anyone know why this error message appears?
Private Sub PopulateData_Click()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim lastDay As Long
lastDay = Day(WorksheetFunction.EoMonth(ComboBox1.Value & Year(Date), 0))
monthNumber = Month(DateValue("01-" & ComboBox1.Value & "-1900"))
Root = "C:\myDirectory\" & Year(Date) & "\" &
monthNumber & ". " & ComboBox1.Value & " " & Year(Date) & "\"
'TOTAL CARS PER WEEK
Dim wbPath2 As Object
sourceFile = monthNumber & ". " & ComboBox1.Value & " " & Year(Date)
sourceSheet = "\[" & ws.Name & " " & monthNumber & "." & lastDay & "." &
Format(Now(), "yy") & ".csv]"
For Each ws In ThisWorkbook.Sheets
If (ws.Name <> "Master") And (ws.Name <> "Combined") Then
Set wbPath2 = Workbooks.Open(Root & ws.Name & " " & monthNumber &
"." & lastDay & "." & Format(Now(), "yy") & ".csv")
With ws
.Cells(Application.WorksheetFunction.Match("Total cars per
week", Range("A:A"), 0), 18).Formula = "=SUM('" & Root &
sourceFile & sourceSheet & ws.Name & " " & monthNumber & "." &
lastDay & "." & Format(Now(), "yy") & "'!$H:$H)"
End With
wbPath2.Close
MsgBox wbPath2
End If
Next
Application.ScreenUpdating = True
End Sub
I had to Set the ws object to resolve run time 91 error. Look in the comments section for Mat's Mug's additional bug fixes.
Private Sub PopulateData_Click()
Application.ScreenUpdating = False
Dim ws As Worksheet
Set ws = ThisWorkbook.Activesheet
'...
I am trying to parse data from multiple workbooks with multiple worksheets into a single summary worksheet or workbook. So far I have been able to collect data from the specified cells, however I would like to include a range of cells for example ("A2:B20"). How can I specify this in looping process?
Option Explicit
Sub GetMyData()
Dim myDir As String, fn As String, sn As String, sn2 As String, n As Long, NR As Long
'***** Change Folder Path *****
myDir = "C:\attach"
'***** Change Sheetname(s) *****
sn = "Title"
sn2 = "Monday"
fn = Dir(myDir & "\*.xlsx")
Do While fn <> ""
If fn <> ThisWorkbook.Name Then
With ThisWorkbook.Sheets("Sheet10")
NR = .Cells(Rows.count, 1).End(xlUp).Row + 1
'Pick cells from worksheet "Title"
With .Range("A" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!B4"
.Value = .Value
End With
With .Range("B" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!B5"
.Value = .Value
End With
With .Range("C" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!B6"
.Value = .Value
End With
With .Range("D" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!B7"
.Value = .Value
End With
With .Range("E" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!A1"
.Value = .Value
End With
With .Range("F" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & sn & "'!A2"
.Value = .Value
End With
'pick cells from worksheet "Monday"
With .Range("G" & NR)
.Formula = "='" & myDir & "\[" & fn & "]" & sn2 & Range("A1:C57")
End With
End With
End If
fn = Dir
Loop
ThisWorkbook.Sheets("Sheet10").Columns.AutoFit
End Sub
You can do Either
Col_1 = "A"
Col_2 = "B"
i = 2
j = 20
Range(Col_1 & i,Col_2 & j)
or
Col_1 = "A"
i = 2
j = 20
Range(Col_1 & i).Resize(j-i+1,2)
Hope this helps
There are a couple of ways to do this, supposing you want a continuous range:
Pass that exact string to the Range function. e.g. Range("A3:C10")
Pass the "first" cell as the first argument and the "last cell" as the second argument. e.g. Range("A3", "C10")
I was working with optimisation of code and after review from man people asked me to use Option Explicit and define Variables for everything and shorten the code. Which i did to maximum possible But the below code copies data from another excel by asking path and copy some specific data in column V and W. Also there is formula which compare data and find exact rows and which need to be copy.
Now please help how should i optimise this code and give variables to it.
Or please provide code in which we can compare 2 excel for example: A2:E is same then it should copy H2:I
For Each ws In MainWB.Worksheets
If ws.Name <> "Sap Data" And ws.Name <> "Automated BL Import" Then
With MainWB.Worksheets(ws.Name)
.Range("V1").Value = "When it will be Cleared or Action Taken/Required"
.Range("W1").Value = "Backup Link"
LastRow = MainWB.Worksheets(ws.Name).Range("B" & Rows.Count).End(xlUp).Row
.Range("Q1:Q" & LastRow).Delete
End With
End If
Next ws
b = MsgBox("Do you want to update comments for current postings from previous month?" & vbCrLf & vbCrLf & "Note:- If are runing this macro for the 1st time plese choose option 'No'", _
vbYesNo + vbQuestion, "Question")
If b = vbYes Then
Filename = Application.GetOpenFilename(, , "Please select previous month BL comment file to update comments.", , False)
If Filename <> "False" Then
Workbooks.Open Filename, Format:=2
End If
updatesheet = ActiveWorkbook.Name
For Each ws In MainWB.Sheets
If ws.Name <> "Sap Data" And ws.Name <> "Automated BL Import" Then
For Each ds In Workbooks(updatesheet).Sheets
If ds.Name = ws.Name Then
LastRow = MainWB.Worksheets(ws.Name).Range("B" & Rows.Count).End(xlUp).Row
With MainWB.Worksheets(ws.Name)
.Range("T2:T" & LastRow).Formula = "=IFERROR(IF(VLOOKUP(RC[-1],'[" & updatesheet & "]" & ws.Name & "'!R2C[-1]:R1048576C,2,0) = 0,"""",VLOOKUP(RC[-1],'[" & updatesheet & "]" & ws.Name & "'!R2C[-1]:R1048576C,2,0)),"""")"
.Range("U2:U" & LastRow).Formula = "=IFERROR(IF(VLOOKUP(RC[-2],'[" & updatesheet & "]" & ws.Name & "'!R2C[-2]:R1048576C,3,0) = 0,"""",VLOOKUP(RC[-2],'[" & updatesheet & "]" & ws.Name & "'!R2C[-2]:R1048576C,3,0)),"""")"
.Range("V2:V" & LastRow).Formula = "=IFERROR(IF(VLOOKUP(RC[-3],'[" & updatesheet & "]" & ws.Name & "'!R2C[-3]:R1048576C,4,0) = 0,"""",VLOOKUP(RC[-3],'[" & updatesheet & "]" & ws.Name & "'!R2C[-3]:R1048576C,4,0)),"""")"
.Range("W2:W" & LastRow).Formula = "=IFERROR(IF(VLOOKUP(RC[-4],'[" & updatesheet & "]" & ws.Name & "'!R2C[-4]:R1048576C,5,0) = 0,"""",VLOOKUP(RC[-4],'[" & updatesheet & "]" & ws.Name & "'!R2C[-4]:R1048576C,5,0)),"""")"
.Range("X2:X" & LastRow).Formula = "=IFERROR(IF(VLOOKUP(RC[-5],'[" & updatesheet & "]" & ws.Name & "'!R2C[-5]:R1048576C,6,0) = 0,"""",VLOOKUP(RC[-5],'[" & updatesheet & "]" & ws.Name & "'!R2C[-5]:R1048576C,6,0)),"""")"
.Range("T2:X" & LastRow).Value = MainWB.Worksheets(ws.Name).Range("T2:X" & LastRow).Value
End With
Your bottom part is a mess, you are missing some end ifs, You are missing the dims for the variables
The first part of the code is below.
You need to explain what you are trying to do with the second part of the code.
Sub Button1_Click()
Dim wb As Workbook, ws As Worksheet
Dim bk As Workbook, sh As Worksheet
Set wb = Workbooks("ThisOne.xlsm")
For Each ws In wb.Sheets
If ws.Name <> "Sap Data" And ws.Name <> "Automated BL Import" Then
With ws
.Range("V1").Value = "When it will be Cleared or Action Taken/Required"
.Range("W1").Value = "Backup Link"
LastRow = ws.Range("B" & Rows.Count).End(xlUp).Row
.Range("Q1:Q" & LastRow).Delete'?
End With
End If
Next ws
b = MsgBox("Do you want to update comments for current postings from previous month?" & vbCrLf & vbCrLf & "Note:- If are runing this macro for the 1st time plese choose option 'No'", _
vbYesNo + vbQuestion, "Question")
If b = vbYes Then
Filename = Application.GetOpenFilename(, , "Please select previous month BL comment file to update comments.", , False)
If Filename <> "False" Then
Workbooks.Open Filename, Format:=2
End If
Else: Exit Sub
End If
Set bk = ActiveWorkbook
' updatesheet = ActiveWorkbook.Name'what is this for?
For Each sh In bk.Sheets
' If sh.Name <> "Sap Data" And ws.Name <> "Automated BL Import" Then
' For Each ds In Workbooks(updatesheet).Sheets
' If ds.Name = ws.Name Then
' LastRow = MainWB.Worksheets(ws.Name).Range("B" & Rows.Count).End(xlUp).Row
' With MainWB.Worksheets(ws.Name)
' .Range("T2:T" & LastRow).Formula = "=IFERROR(IF(VLOOKUP(RC[-1],'[" & updatesheet & "]" & ws.Name & "'!R2C[-1]:R1048576C,2,0) = 0,"""",VLOOKUP(RC[-1],'[" & updatesheet & "]" & ws.Name & "'!R2C[-1]:R1048576C,2,0)),"""")"
' .Range("U2:U" & LastRow).Formula = "=IFERROR(IF(VLOOKUP(RC[-2],'[" & updatesheet & "]" & ws.Name & "'!R2C[-2]:R1048576C,3,0) = 0,"""",VLOOKUP(RC[-2],'[" & updatesheet & "]" & ws.Name & "'!R2C[-2]:R1048576C,3,0)),"""")"
' .Range("V2:V" & LastRow).Formula = "=IFERROR(IF(VLOOKUP(RC[-3],'[" & updatesheet & "]" & ws.Name & "'!R2C[-3]:R1048576C,4,0) = 0,"""",VLOOKUP(RC[-3],'[" & updatesheet & "]" & ws.Name & "'!R2C[-3]:R1048576C,4,0)),"""")"
' .Range("W2:W" & LastRow).Formula = "=IFERROR(IF(VLOOKUP(RC[-4],'[" & updatesheet & "]" & ws.Name & "'!R2C[-4]:R1048576C,5,0) = 0,"""",VLOOKUP(RC[-4],'[" & updatesheet & "]" & ws.Name & "'!R2C[-4]:R1048576C,5,0)),"""")"
' .Range("X2:X" & LastRow).Formula = "=IFERROR(IF(VLOOKUP(RC[-5],'[" & updatesheet & "]" & ws.Name & "'!R2C[-5]:R1048576C,6,0) = 0,"""",VLOOKUP(RC[-5],'[" & updatesheet & "]" & ws.Name & "'!R2C[-5]:R1048576C,6,0)),"""")"
' .Range("T2:X" & LastRow).Value = MainWB.Worksheets(ws.Name).Range("T2:X" & LastRow).Value
' End With
' End If
' Next ds
' End If
Next sh
End Sub
i'm trying to write formula with 2 variables to cell.
formula in cell should be:
=(SUM('C:\Users\[Excel.xlsm]Sheet1'!H:H)-SUM('C:\Users\[Sheet1.xlsm]Sheet1'!I:I))
i want use path to file as variable, as well sheet name.
path = C:\Users\Excel.xlsm 'from msofiledialog
sheetname = Sheet1
what am i missing ?
Cells(1, 1).FormulaR1C1 = "=(SUM('[" & Path & "] " & sheetname & " '!C8) _
-SUM('[" & Path & "] " & sheetname & " '!C9))
thanks, this worked for me :
Sub main
Dim LastRow as String
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim path as String
Path = "C:\users\username\Desktop\"
Dim filename as String
Filename = "Excel.xlsm"
Dim sheetname as String
sheetnameCR = "CR_" & supname
Dim myrangeH as String
Dim myrangeI as String
myrangeH = ("H5:H" & LastRow)
myrangeI = ("I5:I" & LastRow)
Cells(1, 1).Formula = "=SUM('" & Path & "[" & Filename & "]" & sheetnameCR & "'!" & myrangeH & ")" & "-SUM('" & Path & "[" & Filename & "]" & sheetnameCR & "'!" & myrangeI & ")"
End Sub
i had to add "RangeH" variable, because otherwise excel took cell C8, instead of column H, which i wanted.
that's great, but even after i give him full path to desired cell, excel is still asking me for path to excel with FileDialogOpen. any idea why ?
I am trying to generate multiple invoices based on a template and an excel sheet of data and save it. The following code is throwing me a 1004 error - Application defined or object defined error. Can you please help. I am new to vba.
Sub AddNew()
Dim str1, str2, str3 As String
Dim numrows As Integer
Dim i As Integer
numrows = ActiveWorkbook.Sheets("Rawdata").Range("A" & Rows.Count).End(xlUp).Row - 2
MsgBox numrows
i = 3
While numrows > 0
str1 = ActiveWorkbook.Sheets("Rawdata").Cells(i, 16).Value
MsgBox (str1)
str2 = ActiveWorkbook.Sheets("Rawdata").Cells(i, 1).Value
'cannot save filename with backslash
str3 = Replace(ActiveWorkbook.Sheets("Rawdata").Cells(i, 2).Value, "/", "-")
Set NewBook = Workbooks.Add
With NewBook
.Title = "All Invoice"
.Subject = "Invoice"
.SaveAs Filename:="D:\Nandini\Invoice generation automation\" & str1 & " " & Format(str2, "mmm") & "-" & Format(str2, "YYYY") & " " & str3 & ".xlsx"
.Close SaveChanges:=True
End With
ActiveWorkbook.Sheets("Invoice").Select
Cells.Select
Selection.Copy
Workbooks.Open ("D:\Nandini\Invoice generation automation\" & str1 & " " & Format(str2,
"mmm") & "-" & Format(str2, "YYYY") & " " & str3 & ".xlsx")
activeworksheet.Paste
numrows = numrows - 1
i = i + 1
Wend
End Sub
Try below code :
Sub AddNew()
Dim str1, str2, str3 As String
Dim numrows As Integer
Dim i As Integer
Dim NewBook As Workbook, oWkb As Workbook
With ThisWorkbook.Sheets("Rawdata")
numrows = .Range("A" & .Rows.Count).End(xlUp).Row - 2
i = 3
While numrows > 0
str1 = .Cells(i, 16).Value
str2 = .Cells(i, 1).Value
'cannot save filename with backslash
str3 = Replace(.Cells(i, 2).Value, "/", "-")
Set NewBook = Workbooks.Add
With NewBook
.Title = "All Invoice"
.Subject = "Invoice"
.SaveAs Filename:="D:\Nandini\Invoice generation automation\" & str1 & " " & Format(str2, "mmm") & "-" & Format(str2, "YYYY") & " " & str3 & ".xlsx"
.Close SaveChanges:=True
End With
ThisWorkbook.Sheets("Invoice").Cells.Copy
Set oWkb = Workbooks.Open("D:\Nandini\Invoice generation automation\" & str1 & " " & Format(str2, "mmm") & "-" & Format(str2, "YYYY") & " " & str3 & ".xlsx")
oWkb.ActiveSheet.Range("A1").PasteSpecial
numrows = numrows - 1
i = i + 1
Wend
End With
End Sub