Referencing the active range of another workbook vba - vba

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

Related

VBA Loop For Each Workbook and Sheets if avail. loop doesn't activate second sheet

Sub Invoice_Collation()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String, Fnum As Long
Dim mybook As Workbook
Dim CalcMode As Long
Dim sh As Worksheet
Dim ErrorYes As Boolean
Dim wb As Workbook
Dim lastRowI As Long
Dim lastRowE As Long, x
Dim lastRowD As Long
Dim cell As Range
Dim ws As Worksheet
Dim i As Long
Dim shtCount As Long
Dim xWs As Worksheet
MyPath = "D:\Receivables\Sales Invoice copies\Pearson"
Set wb = Workbooks.Open("D:\Receivables\Sales Invoice copies\Invoice Collation.xlsm")
Set ws = Workbooks("Invoice Collation").Worksheets("Sheet1")
'shtCount = Sheets.Count
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If
FilesInPath = Dir(MyPath & "*.xlsx*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
On Error GoTo 0
If Not mybook Is Nothing Then
On Error Resume Next
With mybook.Worksheets(1)
For Each xWs In Application.ActiveWorkbook.Worksheets
With xWs
If .ProtectContents = False Then
ActiveSheet.Cells.UnMerge
ActiveSheet.Cells.WrapText = False
lastRowE = Cells(Rows.Count, "C").End(xlUp).Row
ActiveSheet.Cells.Find(What:="Invoice No.").Offset(1).Select
Selection.Copy
wb.Activate
lastRowI = ws.Range("A" & Rows.Count).End(xlUp).Row
Range("A" & lastRowI).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
mybook.Worksheets(1).Activate
Cells.Find(What:="Title:*", LookAt:=xlPart).EntireRow.Delete 'deletes Title
Cells.Find(What:="Item Number", LookAt:=xlPart).EntireColumn.Delete
Cells.Find(What:="GL Code", LookAt:=xlPart).EntireColumn.Delete
Set cell = Cells.Find(What:="ISBN*", LookAt:=xlWhole)
If cell Is Nothing Then
mybook.Worksheets(1).Cells.Find(What:="Data Processing ").Offset(1).Select
mybook.Worksheets(1).Cells.Find(What:="Data Processing").Offset(1).Select
Else
mybook.Worksheets(1).Cells.Find(What:="ISBN*", LookAt:=xlPart).Offset(1).Select
End If
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
lastRowD = ws.Range("B" & Rows.Count).End(xlUp).Row
wb.Activate
Range("B" & lastRowD).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A" & lastRowI).Offset(1).Select
ActiveCell.Offset(0, 1).Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, -1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Else
ErrorYes = True
End If
End With
Next
End With
Columns("A:A").Select 'Text to col.
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
On Error Resume Next
Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Cells.Find(What:="Amount in Words", LookAt:=xlPart).EntireRow.Delete
On Error GoTo 0
If Err.Number > 0 Then
ErrorYes = True
Err.Clear
mybook.Close savechanges:=False
Else
mybook.Close savechanges:=False
End If
On Error GoTo 0
Else
'Not possible to open the workbook
ErrorYes = True
End If
Next Fnum
End If
If ErrorYes = True Then
MsgBox "There are problems in one or more files, possible problem:" _
& vbNewLine & "protected workbook/sheet or a sheet/range that not exist"
End If
'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub
Dim x as Variant
For Each x in Workbooks('here is your workbook name').Sheets 'loop sheets array
'something you want where x is a sheet variable if you need sheets name-
Debug.Print x.Name
Next x
other variant to loop sheets
For i=1 to Workbooks('here is your workbook name').Sheets.Count' count number of sheets
Debug.Print Workbooks('here is your workbook name').Sheets(i).Name'get the sheet by index
Next i

Trying to save a file as .001 type file, after converting to xcl/txt

I'm writing code in VBA, which should collect file .001 type, convert it to an Excel file (space delimited). Then I need to split it to different files (N steps) and convert it back to .001 file (like original). But I can't reproduce the original .001 form. Can I attach the original file? Are there different ways to split .001 files to N different .001 files?
Sub Import_file()
Dim MFC_name As String
Sheet1.Cells.ClearContents
Range("A1").Select
file_path = Application.GetOpenFilename()
Workbooks.OpenText filename:=file_path, Origin:=437 _
, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
Columns("A:G").Select
Selection.Copy
Windows("code_test.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWindow.ActivateNext
MFC_name = ActiveWorkbook.Name
Application.DisplayAlerts = False
ActiveWindow.Close
Range("I1").Value = MFC_name
Range("A1").Select
End Sub
Sub split_and_write()
Dim totalRows As Long
Dim newBook As Workbook
Dim curRow As Long
Dim filename As Variant
Dim lastRow As Long
Dim path As String
Dim myFileName As String
Dim r As Integer
totalRows = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For curRow = 8 To totalRows Step 1244
Set newBook = Workbooks.Add
With ThisWorkbook.Sheets("Sheet1")
'copy of the 7 rows with name+tool number+time and paste it to new workbook
ThisWorkbook.Worksheets("Sheet1").Range("A1:B7").Copy newBook.Sheets("Sheet1").Range("A1")
'copy and creation of the seperate workboks
.Rows(curRow & ":" & curRow + 1243).EntireRow.Copy newBook.Sheets("Sheet1").Range("A8")
'copy xcl to txt for each workbook
lastRow = newBook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
'creation of .txt file path
path = "C:\XCL_FP\MFC_flow_cal\MFC_test\"
myFileName = InputBox("name?")
myFileName = myFileName & ".001" 'Providing extantion for the file
myFileName = path & myFileName
'writhing .xcl file to.001
Open myFileName For Output As #1
For r = 1 To lastRow
Print #1, Range("A" & r); " "; Range("B" & r)
Next r
Close #1
Application.DisplayAlerts = False
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True
'filename = Application.GetSaveAsFilename
'newBook.saveas filename:=filename
End With
Next curRow
End Sub

.txt to separate worksheets

I'm trying to use the following code to import multiple .txt into separate separate sheets in a workbook. In all of the worksheets it fails to space delimit the last row and from worksheet 2 onward it also fails to copy the first line of the .txt file. All the txt. files are the exactly the same format. Any help appreciated.
Sub CombineTextFiles()
Dim FilesToOpen
Dim x As Integer
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim sDelimiter As String
On Error GoTo ErrHandler
Application.ScreenUpdating = False
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Text Files (*.txt), *.txt", _
MultiSelect:=True, Title:="Text Files to Open")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If
x = 1
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
wkbTemp.Sheets(1).Copy
Set wkbAll = ActiveWorkbook
wkbTemp.Close (False)
wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, _
Comma:=False, Space:=True, Other:=False, OtherChar:="|"
Dim lastrowA As Long
Dim lastrowB As Long
Dim sheetname As String
With ActiveSheet
lastrowA = .Cells(.Rows.Count, "A").End(xlUp).Row
lastrowB = .Cells(.Rows.Count, "B").End(xlUp).Row
sheetname = ActiveSheet.Name
Range("a1").EntireColumn.Insert
Range("a1").Value = sheetname
Range("a2" & ":a" & lastrowB).Value = Range("a1")
Range("a1").EntireRow.Insert
End With
x = x + 1
While x <= UBound(FilesToOpen)
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
With wkbAll
wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
.Worksheets(x).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, _
Comma:=False, Space:=True, Other:=False
End With
With ActiveSheet
lastrowA = .Cells(.Rows.Count, "A").End(xlUp).Row
lastrowB = .Cells(.Rows.Count, "B").End(xlUp).Row
sheetname = ActiveSheet.Name
Range("a1").Value = sheetname
Range("a2" & ":a" & lastrowB).Value = Range("a1")
Range("a1").EntireRow.Insert
End With
x = x + 1
Wend
ExitHandler:
Application.ScreenUpdating = True
Set wkbAll = Nothing
Set wkbTemp = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
If you make a minimal, complete, and verifiable example, you would probably find the mistake yourself. However, by your description for the first row, I guess the problem is here:
With ActiveSheet
lastrowA = .Cells(.Rows.Count, "A").End(xlUp).Row
lastrowB = .Cells(.Rows.Count, "B").End(xlUp).Row
sheetname = ActiveSheet.Name
Range("a1").EntireColumn.Insert
Range("a1").Value = sheetname
Range("a2" & ":a" & lastrowB).Value = Range("a1")
Range("a1").EntireRow.Insert
End With
You need to declare the ranges like this:
With ActiveSheet
lastrowA = .Cells(.Rows.Count, "A").End(xlUp).Row
lastrowB = .Cells(.Rows.Count, "B").End(xlUp).Row
sheetname = ActiveSheet.Name
.Range("a1").EntireColumn.Insert
.Range("a1").Value = sheetname
.Range("a2" & ":a" & lastrowB).Value = .Range("a1")
.Range("a1").EntireRow.Insert
End With
See the dots, they make the difference. If the code is located in a worksheet, then the ranges take the worksheet they are located to, as a Parent worksheet.

Input data from master file to multiple worksheets selecting a specific sheet for each

I’m relatively new in VBA, and currently I’m working on a macro in Master_file.xlsm, which contains multiple ranges of data that have to fill several .xlsb files in a folder.
Sheet Control contains in A2 the Folder path, which contains all the .xlsb files to be filled, and column D the file names.
Sheet Churn contains at column A the same file names, followed by its respective range to be paste at the .xlsb file.
This is all I have so far.
Sub Fill_NNAs()
Dim FilePath As String
Dim iCell As String
Dim BC As String
Application.EnableCancelKey = xlDisabled
Application.ScreenUpdating = False
ActiveWorkbook.Sheets("Control").Activate
LastRow = Range("D2").End(xlDown).Row
intRowCount = LastRow
FilePath = ActiveSheet.Range("A2").Value
For i = 2 To intRowCount
iCell = Cells(i, 4).Value
BC = Cells(i, 3).Value
Worksheets("Churn").Activate
Columns("A:A").Select
x = Selection.Find(What:=BC, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range(ActiveCell.Offset(1, 1), ActiveCell.Offset(3, 64)).Select
Selection.Copy
Workbooks.Open FileName:=FilePath & iCell, ReadOnly:=False, UpdateLinks:=0
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
Sheets("Summary_ARD").Select
Range("C89:BN91").Select
ActiveSheet.Paste
ActiveWindow.Close SaveChanges:=True
Workbooks("Master_file.xlsm").Activate
Sheets("Control").Select
Next
MsgBox "Completed successfully!"
End Sub
As you can see, my loop goes to sheet Control, get the first file name, searches for it on Churn, copies its respective range, open Filename.xlsb, activated Summary_ARD sheet, paste it and goes to the next.
It has been working fine, but now I have a new problem:
Some xlsb files have more than one “Summary_ARD” sheet, like Summary_ARD, Summary_ARD (2), Summary_ARD (3), and some have New_ARD sheet instead of Summary_ARD.
So, what my code has to do now when open a new Filename.xlsb is:
Activate the Summary_ARD with the highest number in parenthesis (Summary_ARD (5) instead of (4), etc).
If there is no sheet Summary_ARD (number), activate Summary_ARD.
If there is no sheet Summary_ARD, activate New_ARD.
For all itens above, it has to look only in the visible sheets.
Any ideas?
If whatever your target sheet is is the last sheet in the WB, you can just reference it by its .index number - the last one being sheets.count -
Oh, I restructured your code so you're not using .selection or .activate
Sub Fill_NNAs()
Application.EnableCancelKey = xlDisabled
Application.ScreenUpdating = False
Dim wbDest As Workbook
Dim FilePath As String
FilePath = ActiveSheet.Range("A2").Value
Dim iCell As String
Dim BC As String
Dim rngSearch As Range
Dim lastrow As Integer
lastrow = Range("D2").End(xlDown).Row
Dim wsControl As Worksheet
wsControl = ThisWorkbook.Sheets("Control")
Dim wsChurn As Worksheet
wsChurn -ThisWorkbook.Sheets("Churn")
For i = 2 To lastrow
iCell = wsControl.Cells(i, 4).Value
BC = wsControl.Cells(i, 3).Value
Set rngSearch = wsChurn.Columns(1).Find(What:=BC, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set rngSearch = Range(rngSearch.Offset(1, 1), rngSearch.Offset(3, 64))
Workbooks.Open Filename:=FilePath & iCell, ReadOnly:=False, UpdateLinks:=0
ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
ActiveWorkbook.Sheets(Sheets.Count).Range("C89:BN91") = rngSearch
ActiveWindow.Close SaveChanges:=True
Next
MsgBox "Completed successfully!"
End Sub
Otherwise, you might need to get a little tricky with something like this -
Sub testb()
Dim j As Integer
j = 0
Dim wsDest As Worksheet
For Each ws In ThisWorkbook.Sheets
If InStr(1, ws.Name, "(") Then
If Mid(ws.Name, InStr(1, ws.Name, "(") + 1, 1) > j Then
j = Mid(ws.Name, InStr(1, ws.Name, "(") + 1, 1)
End If
End If
Next
If j = 0 Then
If SheetExists("Summary_ARD") Then
wsDest = ThisWorkbook.Sheets("Summary_ARD")
Else: wsDest = ThisWorkbook.Sheets("New_ARD")
GoTo label
End If
End If
Set wsDest = ActiveWorkbook.Sheets("Summary_ARD(" & j & ")")
label:
'do stuff with wsdest
End Sub
Function SheetExists(strWSName As String) As Boolean
Dim ShTest As Worksheet
On Error Resume Next
Set ShTest = Worksheets(strWSName)
If Not ShTest Is Nothing Then SheetExists = True
End Function
For your loop to find the sheet, this might work
Sub findsheet()
Dim i As Integer
Dim shTest As Worksheet
For i = 1 To 20
On Error GoTo label
Set shTest = Worksheets("Summary_ARD(" & i & ")")
Next
label:
If i > 1 Then
Set shTest = Worksheets("Summary_ARD(" & i - 1 & ")")
GoTo label3
End
On Error GoTo label2
Set shTest = Worksheets("Summary_ARD")
GoTo label3
label2:
Set shTest = Worksheets("New_ARD")
GoTo label3
label3:
'do stuff
End Sub
I don't know if i'm being dumb (probably), but I just put your loop in the place of mine old Sheets("Summary_ARD").Select, and it doesn't work. I got stuck in the "label" line.
Sub Fill_NNAs()
Dim FilePath As String
Dim iCell As String
Dim BC As String
Application.EnableCancelKey = xlDisabled
Application.ScreenUpdating = False
ActiveWorkbook.Sheets("Control").Activate
LastRow = Range("D2").End(xlDown).Row
intRowCount = LastRow
FilePath = ActiveSheet.Range("A2").Value
For i = 2 To intRowCount
iCell = Cells(i, 4).Value
BC = Cells(i, 3).Value
Worksheets("Churn").Activate
Columns("A:A").Select
x = Selection.Find(What:=BC, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Range(ActiveCell.Offset(1, 1), ActiveCell.Offset(3, 64)).Select
Selection.Copy Workbooks.Open FileName:=FilePath & iCell, ReadOnly:=False, UpdateLinks:=0 ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
On Error GoTo label
Set shTest = Worksheets("Summary_ARD(" & i & ")")
Next
label:
If i > 2 Then
Set shTest = Worksheets("Summary_ARD(" & i - 1 & ")")
GoTo label3
End
On Error GoTo label2
Set shTest = Worksheets("Summary_ARD")
GoTo label3
label2:
Set shTest = Worksheets("New_ARD")
GoTo label3
label3:
Range("C89:BN91").Select
ActiveSheet.Paste
ActiveWindow.Close SaveChanges:=True
Workbooks("Master_file.xlsm").Activate
Sheets("Control").Select
Next
MsgBox "Completed successfully!"
End Sub
Oh sorry, I don't use your re-writed code.

Compare two workbooks using VBA

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