I was trying to compare two different Workbooks, one named "after" (which is up to date) and another called "before" and I wanted to highlight the differences so it would be easy to pin down what changed between the two.
Okay so after I tested it a bit I got stuck in an error
"Object doesn't support this property or method".
Here's the full code with added comments so you can follow my thought process:
Sub OpenCsv()
Dim zcf, FolderPath, after, before, shtAfter, shtBefore As String
Dim MotherWB As Workbook, MotherWS As Worksheet
Dim wb As Workbook, ws, worksheetz As Worksheet
Dim oneRange, aCell As Range
Dim rng As Range
Dim Answer As Integer
Dim mycell As Range
Dim mydiffs As Integer
'Sorts Things for MotherWB
Set oneRange = Range("A4:Z9000")
Set aCell = Range("F4")
oneRange.Sort Key1:=aCell, Order1:=xlAscending, Header:=xlYes
'Opens and sets both Workbooks with their respective sheets
FolderPath = Application.ActiveWorkbook.Path
after = FolderPath + "\" + "after.csv"
before = FolderPath + "\" + "before.xlsm"
Workbooks.Open (after)
Set wb = Workbooks("after.csv")
Set ws = wb.Worksheets("after")
Set MotherWB = Workbooks("before.xlsm")
Set MotherWS = MotherWB.Worksheets("before")
'Makes ws looks like MotherWS so we compare them
With ws
Columns("A:Z").AutoFit
Selection.TextToColumns _
Destination:=Range("A1:A9000"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=True, _
Space:=False, _
Other:=False
Set oneRange = Range("A4:Z9000")
Set aCell = Range("F4")
oneRange.Sort Key1:=aCell, Order1:=xlAscending, Header:=xlYes
End With
'Questions if you want to compare both
Answer = MsgBox("Uma vez aberto o relatório deseja comparar os dois?", vbYesNo + vbQuestion, "Comparar")
If Answer = 6 Then
'For each cell in after that is not the same in before, color it yellow
For Each mycell In wb.ws(after).UsedRange
If Not mycell.Value = MotherWB.MotherWS(before).Cells(mycell.row, mycell.Column).Value Then
mycell.Interior.Color = vbYellow
mydiffs = mydiffs + 1
End If
Next
'Display a message box to demonstrate the differences
MsgBox mydiffs & " differences found", vbInformation
ActiveWorkbook.Sheets(after).Select
End If
End Sub
It gets the error after I return 6 from the answer, saying what I stated above. What am I doing wrong?
Answer is set as boolean and the msgbox will return a integer. Declare an integer and then use an if statement to put true/false in your answer variable. Something similar to below
Dim temp as integer
temp = MsgBox("Uma vez aberto o relatório deseja comparar os dois?", vbYesNo + vbQuestion, "Comparar")
if temp = 6 then
Answer = true
else
Answer = false
endif
Related
Problem: I am unable to define a range using a variable (i) and specific cells row (cell.Row).
Current Code:
Sub TaskSearch()
'Dim wb As Workbook
Dim oSht As Worksheet
Dim lastRow As Long, i As Long
Dim strSearch As String
Dim aCell As Range
ThisWorkbook.Sheets("Interface").Range("D19:D33").ClearContents
'Set wb = Workbooks.Open("H:\Kevin.Boots\Database.xlsx")
Set oSht = Sheets("TaskMaster")
lastRow = oSht.Range("A" & Rows.Count).End(xlUp).Row
strSearch = Sheets("Interface").Range("F5")
Set aCell = oSht.Range("B2:B" & lastRow).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False)
Sheets("Interface").Range("D19").Value = Sheets("TaskMaster").Range("C" & aCell.Row).Value
Sheets("Interface").Range("D20").Value = Sheets("TaskMaster").Range("D" & aCell.Row).Value
Sheets("Interface").Range("D21").Value = Sheets("TaskMaster").Range("E" & aCell.Row).Value
Sheets("Interface").Range("D22").Value = Sheets("TaskMaster").Range("F" & aCell.Row).Value
Sheets("Interface").Range("D23").Value = Sheets("TaskMaster").Range("G" & aCell.Row).Value
Sheets("Interface").Range("D24").Value = Sheets("TaskMaster").Range("H" & aCell.Row).Value
Sheets("Interface").Range("D25").Value = Sheets("TaskMaster").Range("I" & aCell.Row).Value
Sheets("Interface").Range("D26").Value = Sheets("TaskMaster").Range("J" & aCell.Row).Value
Sheets("Interface").Range("D27").Value = Sheets("TaskMaster").Range("K" & aCell.Row).Value
Sheets("Interface").Range("D28").Value = Sheets("TaskMaster").Range("L" & aCell.Row).Value
Sheets("Interface").Range("D29").Value = Sheets("TaskMaster").Range("M" & aCell.Row).Value
Sheets("Interface").Range("D30").Value = Sheets("TaskMaster").Range("N" & aCell.Row).Value
Sheets("Interface").Range("D31").Value = Sheets("TaskMaster").Range("O" & aCell.Row).Value
Sheets("Interface").Range("D32").Value = Sheets("TaskMaster").Range("P" & aCell.Row).Value
Sheets("Interface").Range("D33").Value = Sheets("TaskMaster").Range("Q" & aCell.Row).Value
Exit Sub
End Sub
Objective: I am attempting to make this code more robust. Part of reasoning is for me to be able to skip blanks. This is a nightmare when trying to adjust cells.
I have tried two different methods to accomplish this:
Method A:
wb.Sheets("Interface").Range("D19:D33").Copy
wb.Sheets("TaskMaster").Range("C" & aCell.Row & ":Q" & aCell.Row).PastSpecial Paste:=xlPasteValues, SkipBlanks:=True
Failure: Runtime Error 438: Object doesn't support this property or method.
Method B:
For j = 3 To 16
If Not IsEmpty(j, aCell.Row) Then
For i = 19 To 33
iWb.oSht.Range(j, aCell.Row).Value = _
iWb.iSht.Range(4, i).Value
Next i
End If
Next j
Exit Sub
Failure: ( I cant get this older version to compile again) I believe the error arose with issues defining the range.
To summarize I am trying to find the fastest method to transfer information from one worksheet to another worksheet using the .find. I am also trying to not copy blank cells while transferring.
I currently believe this method will be the best suited for my application.
Sub TSearch()
Dim dWb As Workbook, Wb As Workbook
Dim oSht As Worksheet, Sht As Worksheet
Dim lastRow As Long, i As Long, j As Long
Dim strSearch As String
Dim aCell As Variant
Dim cell As Variant
'On Error GoTo Err
ThisWorkbook.Sheets("Interface").Range("D19:D33").ClearContents
'Set dWb = Workbooks.Open("H:\Kevin.Boots\Database.xlsx")
Set Wb = ThisWorkbook
Set Sht = Sheets("TaskMaster") ' Reference Worksheet
Set oSht = Sheets("Interface") ' User Interface Worksheet
lastRow = Sht.Range("A" & Rows.Count).End(xlUp).Row 'Obtain Last row of reference Worksheet
strSearch = oSht.Range("F5") 'Obtain User Selected Search Criteria
Set aCell = Sht.Range("B2:B" & lastRow).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False)
For j = 3 To 16 'Columns from Reference Worksheet to be transfered
If Not IsEmpty(Wb.Sht.Cells(aCell.Row, j)) Then ' Verify If cell has value before transfering
For i = 19 To 33 ' Rows of User Interface where values are to be transfered
Wb.Sht.Cells(aCell.Row, j).Value = _
Wb.oSht.Cells(i, 4).Value
Next i
End If
Next j
Exit Sub
'Err: 'MsgBox " Generic Task not found" & vbCrLf
End Sub
The IEmpty Function is still causing an error 438: Object doesn't support this property method. If I remove the IsEmpty then
'Wb.Sht.Cells(aCell.Row, j).Value = Wb.oSht.Cells(i, 4).Value' gives me the same error.
Your loop won't work due to IsEmpty which expects a single cell or variable to check, but you are giving it two numbers. The below should work, but some things aren't qualified, so you may still run into issues. Also, Range() expects either two ranges to be provided, or a range string. I think you were looking for Cells(), which accepts a row (as a number) as the first parameter and a column (as a number) as the second.
For j = 3 To 16
If Not IsEmpty(cells(aCell.Row, j)) Then
For i = 19 To 33
iWb.oSht.Cells(aCell.Row, j).Value = _
iWb.iSht.Cells(4, i).Value
Next i
End If
Next j
End Sub
It appears the errors were a result of trying to define something that was defined.
Sub TSearch()
Dim dWb As Workbook, Wb As Workbook
Dim oSht As Worksheet, Sht As Worksheet
Dim lastRow As Long, i As Long, j As Long
Dim strSearch As String
Dim aCell As Variant
Dim cell As Variant
'On Error GoTo Err
ThisWorkbook.Sheets("Interface").Range("D19:D33").ClearContents
'Set dWb = Workbooks.Open("H:\Kevin.Boots\Database.xlsx")
Set Wb = ThisWorkbook
Set Sht = Sheets("TaskMaster") ' Reference Worksheet
Set oSht = Sheets("Interface") ' User Interface Worksheet
lastRow = Sht.Range("A" & Rows.Count).End(xlUp).Row 'Obtain Last row of reference Worksheet
strSearch = oSht.Range("F5") 'Obtain User Selected Search Criteria
'Find Row in Reference Worksheet that Matches Search Criteria
Set aCell = Sht.Range("B2:B" & lastRow).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False)
For j = 3 To 16
If Not IsEmpty(Cells(aCell.Row, j)) Then
i = j + 16
oSht.Cells(i, 4).Value = Cells(aCell.Row, j).Value
End If
Next j
Exit Sub
'Err:
'MsgBox " Generic Task not found" & vbCrLf
End Sub
Thank you to #Jordan and #Kyle for helping solve this issue.
Hi I have a problem with a macro which copies information from one workbook and paste it into another. Then it creates two columns and fill them with an IF formula to compare two dates. Those formulas bring the wrong result as one of the columns have another date format, and I can't change it, whatever I do on the cell is not working, only if I erase the value on any cell of that column and write a date I can change the format.
The main format needed is YYYY-MM-DD, but this column is set as dd/mm/yyyy, even if I update the cell and set it as date or custom it doesn't work at all, it keeps showing the wrong format.
This is the macro I work on, is there any way to solve this issue?
Thank you in advance.
Sub AD_Audit()
'Last cell in column
Dim ws As Worksheet
Dim LastCell As Range
Dim LastCellRowNumber As Long
Dim wb3 As Workbook
Set ws = Worksheets(2)
With ws
Set LastCell = .Cells(.Rows.Count, "A").End(xlUp)
LastCellRowNumber = LastCell.Row + 1
End With
Dim Wb As Workbook, wb2 As Workbook
Dim vFile As Variant
'Set source workbook
Set Wb = ActiveWorkbook
'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
1, "Select One File To Open", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile
'Set selectedworkbook
Set wb2 = ActiveWorkbook
'Select cells to copy
wb2.Worksheets(2).Range("A1:BD" & ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row).Select
Selection.Copy
'Go back to original workbook you want to paste into
Wb.Activate
'Paste starting at the last empty row
Wb.Worksheets(2).Activate
Wb.Worksheets(2).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
Dim LstrDate As String
Dim LDate As Date
LstrDate = "Apr 6, 2003"
LDate = CDate(LstrDate)
'search for columns containing the data needed
Dim x As Integer
Dim lastRow As Long
lastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim rFind As Range
With Range("A:DB")
Set rFind = .Find(What:="Account Last Updated", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
End If
End With
Dim rFind1 As Range
With Range("A:DB")
Set rFind1 = .Find(What:="Termination Date", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rFind1 Is Nothing Then
End If
End With
Dim rFind2 As Range
With Range("A:DB")
Set rFind2 = .Find(What:="Last Password set date", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rFind2 Is Nothing Then
End If
End With
'create columns and fill them with formulas
x = ActiveSheet.UsedRange.Columns.Count
ActiveSheet.Cells(1, x + 1) = "Account last updated after termination"
intcounter = 2
While (intcounter <= lastRow)
ActiveSheet.Cells(intcounter, x + 1).Formula = "=IF(TEXT(""" & Cells(intcounter, rFind.Column) & """,""YYYY/MM/DD"")>=TEXT(""" & Cells(intcounter, rFind1.Column) & """,""YYYY/MM/DD""),""review"",""disabled"")"
intcounter = intcounter + 1
Wend
x = ActiveSheet.UsedRange.Columns.Count
ActiveSheet.Cells(1, x + 1) = "Password After Termination"
intcounter = 2
While (intcounter <= lastRow)
ActiveSheet.Cells(intcounter, x + 1).Formula = "=IF(TEXT(""" & Cells(intcounter, rFind2.Column) & """,""YYYY/MM/DD"")>=TEXT(""" & Cells(intcounter, rFind1.Column) & """,""YYYY/MM/DD""),""review"",""old"")"
intcounter = intcounter + 1
Wend
'add column Actions
Worksheets(2).Range("A1").EntireColumn.Insert
Worksheets(2).Range("A1").Formula = "Actions"
'Set headers to bold text
Rows(1).Font.Bold = True
'check for filter, turn on if none exists
If Not ActiveSheet.AutoFilterMode Then
ActiveSheet.Range("A1:BD1").AutoFilter
End If
Dim Notes As Object, Maildb As Object, workspace As Object, UIdoc As Object, UserName As String
Dim MailDbName As String
ThisWorkbook.Activate
For Each Wb In Workbooks
If Not (Wb Is ActiveWorkbook) Then Wb.Close savechanges:=False
Next
End Sub
Date values are stored in a worksheet cell as a numerical value so different formats can be applied to different cells and still retain the ability to compare (or add, subtract, etc). The formula you're applied to each cell is forcing a comparison in a specific text format when the actual value.
The key is to set your formula up to use the address of the cell, not the cell contents.
So your cell formula can simply be:
ActiveSheet.Cells(intcounter, x + 1).Formula = "=If(" & Cells(intcounter, rFind.Column).Address & ">=" & Cells(intcounter, rFind1.Column).Address & ","""review""","""disabled""")"
I'm having a run-time error 91 and I have no idea why. I used this code for a different workbook and it works perfectly, the information in the columns are different that I'm extracting but I changed all the columns and ranges to the correct one, but now I'm getting this error here and the only difference is the Range, please help!
Range(Cells(20, 1), Cells(LastRow, LastCol)).Select
Selection.AutoFilter
Range("C2").Select
That is the beginning but here is where the error occurs:
ActiveWorkbook.Worksheets(msheet).AutoFilter.Sort.SortFields. _
Add Key:=Range("A20:A" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
Please help, I don't know what I'm missing. Thanks!
Here is the beginning of the code:
Sub getdata()
Dim mastername As String
Dim count As Long
Dim match As Long
Dim repeat As Long
Dim path As String
Dim status As String
Dim name As String
Dim mpath As String
Dim cpath As String
Dim LastRow As Long
Dim LastCol As Integer
Dim mbank As String
Dim mname As String
mpath = Sheets("Master log").Cells(14, "W").Value
mname = Sheets("Master log").Cells(15, "W").Value
msheet = Sheets("Master log").Cells(16, "W").Value
Sheets("MGPR1").Range("A1:AA50000").ClearContents
name = Application.ActiveWorkbook.name
cpath = Application.ActiveWorkbook.path & "\"
Windows(name).Activate
'--open Management report workbook if not already open
If CheckFileIsOpen(mname) = False Then
Workbooks.Open mpath & mname
End If
'-------------------------------------------
Windows(mname).Activate
Sheets(msheet).Select
'select full data
With ActiveSheet
LastRow = .Cells(.Rows.count, "A").End(xlUp).Row
End With
With ActiveSheet
' LastCol = .Cells(1, .Columns.count).End(xlToLeft).Column
LastCol = 20
End With
you have to reference the sheet of the range("A20.....") or else its in activesheet.
Something like sh.range("...") , or use a with section like this example:
with ActiveWorkbook.Worksheets(msheet)
.AutoFilter.Sort.SortFields. _
Add Key:= .Range("A20:A" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
end with
also to help referencing, and stop using activate/select :
Dim Wb as Workbook
Dim Sh as Worksheet
'other code, i just write the needed code now
set wb = Workbooks.Open mpath & mname
set Sh = wb.Sheets(msheet)
with Sh
LastRow = .Cells(.Rows.count, "A").End(xlUp).Row
'lots of stuff to do (....) please wait , computing .... error / no really i try to be serious here!
end with
The meaning of the error is:
91 - Object variable not set
It is obtuse the chain of objects involved. This is a Recorded Macro that does the type of thing you are trying to do. If in doubt unwind a complex statement into simplier ones.
Also always do a Msgbox Vartype(whatever):Msgbox IsEmpty(whatever):msgbox IsNull(whatever). This allows you to check assumptions on what something is.
Range("A1:G19").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="<>sub", Operator:=xlAnd
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("H34").Select
Ok, so I am trying to perform a batch interpolation macro on some files in a folder and would like to know how I can refrence the ActiveRange from the .XLSM and feed it back into the for next loop for each selected file.
Sub Batch_Interpolate_Blanks()
Dim SaveDriveDir As String
Dim MyPath As String
Dim Fname As Variant
Dim N As Long
Dim FnameInLoop As String
Dim mybook As Workbook
Dim myRange As Range
Dim myRange2 As Range
Dim EntireRange As Range
SaveDriveDir = CurDir
MyPath = Application.DefaultFilePath
ChDrive MyPath
ChDir MyPath
Fname = Application.GetOpenFilename(Title:="Select a file or files", MultiSelect:=True)
If IsArray(Fname) Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
RangeSelect: Set myRange = Application.InputBox(Prompt:= _
"Please Select the Column you wish to Interpolate. ", _
Title:="InputBox", Type:=8)
If myRange Is Nothing Then
Else
myRange.Select
End If
For N = LBound(Fname) To UBound(Fname)
FnameInLoop = Right(Fname(N), Len(Fname(N)) - InStrRev(Fname(N), Application.PathSeparator, , 1))
If bIsBookOpen(FnameInLoop) = False Then
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(Fname(N))
On Error GoTo 0
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Columns("A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
TrailingMinusNumbers:=True
'Here is where I think I should reference RangeSelect Somehow!!
'Something Like Workbooks.("Otherworkbook").Activate then make active range = RangeSelect
Start = ActiveCell
EndRow = Range("A" & Rows.Count).End(xlUp).Row
Do Until ActiveCell.Row = EndRow
Selection.Offset(1, 0).Select
'Perform my macro function below etc
If someone can think of a way to do this it would be great! Any more info needed Please Ask!
Tom
Edit:Essentially I want to reference the active range of a 'Master Workbook' and select it in a destination workbook without an absolute reference!
Something along these lines. Note you don't need to Select ranges in order to work with them...
Dim c As Range
'using .Cells(1) in case user selected >1 cell
Set c = mybook.ActiveSheet.Range(myRange.Cells(1).Address())
EndRow = Range("A" & Rows.Count).End(xlUp).Row
Do While c.Row <= EndRow
c.Offset(1, 0).Select
'etc....
Set c = c.Offset(1, 0)
Loop
I have a macro programme to do some operations like Vlookup, deleting columns etc. The file to be updated would have a few worksheets in it and every time the worksheets' name and order may be different. Thus, I would like to be able to choose the worksheet I want every time I use the macro. However, I haven't be successful.....
This is the macro. I wanted the mySheet to be variable. Ideally, It can prompt me to choose the worksheet I want within that wbSource..However, I have been getting errors. Anyone know how do I do it?
Thanks in advance!
Sub Macro1()
Dim file1 As String
Dim file2 As String
Dim wbSource As Workbook
Dim wbLookup As Workbook
Dim startRange As Range
Dim mySheet As Worksheet
Dim col As Range
Dim Del As Range
file1 = Application.GetOpenFilename(Title:="Select the file to update")
If Len(Dir(file1)) = 0 Then Exit Sub
file2 = Application.GetOpenFilename(Title:="Select the LOOKUP file")
If Len(Dir(file2)) = 0 Then Exit Sub
Set wbLookup = Workbooks.Open(file2)
Set wbSource = Workbooks.Open(file1)
Set mySheet = wbSource.Sheets(ActiveSheet.Name)
On Error Resume Next
Application.DisplayAlerts = False
Set col = Application.InputBox _
(Prompt:="Select Column.", _
Title:="Where do you want to insert the columns?", Type:=8)
On Error GoTo 0
Application.DisplayAlerts = True
col.Resize(, 5).EntireColumn.Insert
On Error Resume Next
Application.DisplayAlerts = False
Set Del = Application.InputBox _
(Prompt:="Select Column.", _
Title:="Which column to delimit?", Type:=8)
On Error GoTo 0
Application.DisplayAlerts = True
Del.EntireColumn.Select '** ERROR HERE!!
Selection.TextToColumns _
Destination:=Del, _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=False, _
Space:=False, _
Other:=True, _
OtherChar:="-"
Del.Offset(0, 2).Delete
Del.Offset(0, 1).Delete
On Error Resume Next
Set startRange = Application.InputBox("Select the first cell for the formula", "Autofill VLOOKUP", Type:=8)
On Error GoTo 0
If Not startRange Is Nothing Then
Application.Goto startRange
startRange.FormulaR1C1 = "=VLOOKUP('[" & wbSource.Name & "]" & mySheet.Name & "'!RC[-1],'[" & wbLookup.Name & "]NON SLL'!C1:C3,3,FALSE)"
End If
End Sub
Some continuation from comments and possible explanation of problems...
Your code isn't making any errors. However, there could be some logic mistakes which you should consider. This line of code:
Set wbSource = Workbooks.Open(file1)
activate the workbook just opened (file1). And next line:
Set mySheet = wbSource.Sheets(ActiveSheet.Name)
set variable to sheet in just opened workbook (file1) and sheet which is currently active there.
And general question- is this correct for the logic of further part of your code?