Vlookup Syntax and user input issues - excel

I'm trying to create a macro that compares two user in-putted worksheets then moves the differences to different sheets depending on why its different.
The code first asks for input of the newest data and opens that sheet. Then it asks for the location of the older data to compare with but doesn't open it. It adds the necessary sheets to copy to.
It then goes down a column cell by cell looking for the matching serial on the second work book (this is mainly to ensure that its comparing the correct data in-case formatting is off). Once it finds the matching serial it compares the second serial for both entry's and depending on if its different or new input into one of the sheets.
The main issue I'm having is with VLookup. It is having multiple errors 424, 1004 and Compile expression errors. I need a little guidance as to why its having these issues. I have searched and found a lot on needing to have brackets to reference a file but when I follow those formats exactly it throws the expression error.
Any advice is appreciated.
Sub Compare()
'Open workbooks
''Worksheet 1
Dim filter As String
Dim caption As String
Dim WB1FN As String
Dim WB1 As Workbook
filter = "Excel Sheets (*.xlsx),*.xlsx"
caption = "Please select newest equipment file"
MsgBox (caption)
WB1FN = Application.GetOpenFilename(filter, , caption)
If WB1FN = "False" Then
MsgBox "File not selected to import"
Exit Sub
End If
Set WB1 = Application.Workbooks.Open(WB1FN)
''Worksheet 2
Dim caption2 As String
Dim WB2FN As String
filter = "Excel Sheets (*.xlsx),*.xlsx"
caption2 = "Please select previous equipment file"
MsgBox (caption2)
WB2FN = Application.GetOpenFilename(filter, , caption)
If WB2FN = "False" Then
MsgBox "File not selected to import"
Exit Sub
End If
'Comparing data
''MS find and compare
Dim MS1 As String
Dim ESN1 As String
Dim ESN2 As String
Dim LastRow As Long
Dim i As Integer
Dim d As Integer
Dim n As Integer
Dim Filename As String
d = 4
n = 4
Set WB1 = ActiveWorkbook
'Create sheets
Sheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)).Name = "A"
Sheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)).Name = "B"
Sheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)).Name = "C"
'Gets the last row number
ActiveWorkbook.Sheets(1).Activate
LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For i = 4 To LastRow
''Assigning MS1,ES1,ES2
MS1 = Cells(i, 6)
ESN1 = Cells(i, 15)
ESN2 = Application.WorksheetFunction.VLookup(MS1, '[" & WB2FN & "]Sheet1'! [R3C6:R10000C15], 10, False)
''Compare ESN and copy data
If ESN2 <> ESN1 Then
cell.EntireRow.Copy Sheets(2).Cells(d, 1)
n = d + 1
ElseIf Application.WorksheetFunction.IsNA(ESN2) = "TRUE" Then
cell.EntireRow.Copy Sheets(4).Cells(n, 1)
n = n + 1
End If
Next i
'X find and copy
Dim OEM As String
ActiveWorkbook.Sheets(2).Activate
LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
n = 3
i = 3
For i = 3 To LastRow
''Check for X
OEM = Cells(i, 4)
If OEM = "x" Then
cell.EntireRow.Copy Sheets(3).Cells(n, 1)
n = n + 1
End If
Next i
MsgBox "Compare successful"
End Sub

have brackets to reference a file You can only use that approach if you are assigning a formula to a cell or range.
Example:
Dim myformula As String
myformula = "=VLOOKUP(" & MS1 & _
",'[" & WB2FN & "]Sheet1'! [R3C6:R10000C15], 10, False)"
Range("A1").Formula = myformula
But if you use VBA Worksheet Function, you need to somehow access the database or table you are fetching data from at runtime. Meaning you have to pass objects on the arguments and not strings as you do in above.
Something like:
'~~> the rest of your code before Vlookup here
Dim wb As Workbook
Dim mytable As Range
Set wb = Workbooks.Open(WN2FN, , True) '~~> read only, avoid errors when file in use
Set mytable = wb.Sheets("Sheet1").Range("F3:O10000")
On Error Resume Next '~~> to handle when Vlookup returns #N/A or errors out
ESN2 = Application.WorksheetFunction.VLookup(MS1, mytable, 5, 0)
If Err.Number <> 0 Then myvalue = CVErr(xlErrNA)
On Error GoTo 0 '~~> reset error handling to trap other errors
Debug.Print ESN2
I just provided the part where you use the Vlookup WorksheetFunction. You can use the rest of your code before it. Basically above code:
assigns source table to variable and passed it directly to Vlookup arguments.
Uses Vlookup via VBA WorksheetFunction to fetch data.
Take note of the OERN (On Error Resume Next) routine and OEG0 (On Error Goto 0).
In VBA when a Worksheet Function returns an error (eg. #N/A for Vlookup), the code errors out and stops execution. There is no IFERROR like we have in worksheet formulas. So you need to handle it using error handling routines.
Also take note that it is better to fully qualify the objects you're working on.
This is a good place to start to optimize your codes and avoid runtime errors.

Related

Compare two Excel workbooks for differences and copy/paste all the information from one to another

On some difficult issue I am bumped in. And i guess it quite out of my knowledge, and I hope it is even possible to solve on some way.
ISSUE:
Two different workbooks: I am having one workbook with 10 sheets inside, with many formulas, dropdowns, calculations etc., and it is main version of the document which has to be filled with information.
Second workbook, or better to say another similar version to this workbook is like obsolete versions of main wb, where might be possible that some cells/format, or even sheet is missing, but in general almost the same from its structure.
PROCESS:
Sometimes the customers are not having the newest version of excel workbook, but still some of the obsolete versions (they are forgetting to use the newest version), and they are filling those fields inside those older versions and sending them back. The problem is, our ERP Software cant read the obsolete versions, because it is so adjusted to read only the newest version of the document. Meaning, it has to be manually checked every time when the document is sent back and finding discrepancies and copy/paste them into newest version of the document, and then upload it into ERP...
RESULT:
I am looking for some solution, with VBA or even formulas how to check every other workbook against "newest" and if there are any discrepancy and differences just to copy/paste everything from old to new version. When I say "everything" it means, all the fields, sheets, calculations, 1:1.
Unfortunately I am not writing any code or formula, because this is for me super advanced.
On the pic below is one example of one sheet how it looks like. There are lot of columns, calcs and so on.
Explanation:
To clarify bit better the content: inside one workbook is usually 10 sheets. 8x of them are the same (gas chambers from 1-8) and depending on the customer wishes, they can populated from 1-8. Sometimes 1 sometimes 5.
And range is from A1:Q54, full of data, tables, calculations, dropdowns, infos..
One sheet (9th) is customer details and last one (10th) is just instruction sheet with infos and screenshots.
So optimal would be to have macro that is taking everything from older versions, compare it with new one, and populate data that it finds, or on already given workbook or on new one but with the same content. I dont know if that is something possible.
An example of how to scan various cell ranges in a workbook and collate those that have values into a table. Second stage would be to transfer those values to the new format template.
Option Explicit
Sub extractAll()
Dim myfile As String, wb As Workbook, ws As Worksheet
Dim n As Long, rng1 As Range, rng2 As Range, msg As String
' select workbook to scan
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Please select a file"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
MsgBox "You did not select a file"
Exit Sub
End If
myfile = .SelectedItems(1)
End With
' collate data on sheet 1 and 2
Sheet1.Cells.Clear
Sheet1.Range("A1:E1") = Array("Sheet", "Addr", "Row", "Column", "Value")
Set rng1 = Sheet1.Range("A2")
Sheet2.Cells.Clear
Sheet2.Range("A1:D1") = Array("Addr", "Row", "Column", "Value")
Set rng2 = Sheet2.Range("A2")
' open workbook and scan worksheets
Set wb = Workbooks.Open(myfile, ReadOnly:=True)
For Each ws In wb.Sheets
If ws.Name Like "CH_recipe_#" Then
Call scanSheet(ws, rng1)
msg = msg & vbLf & ws.Name
ElseIf ws.Name = "Customer Details" Then
Call scanCustomer(ws, rng2)
msg = msg & vbLf & ws.Name
End If
Next
wb.Close savechanges:=False
MsgBox "Sheets scanned" & msg
End Sub
Sub scanSheet(ws As Worksheet, ByRef rng As Range)
Dim cell As Range, ar, s As String
Dim i As Long, n As Long
' old template layout
s = "D13,A15,C15,D15,E15,G15,J15,N15," ' process details
s = s & "E20:P24,E41:P41," ' Carrier, Gas 2-12, usage
s = s & "C45,D45,E45,G45,I45,K45,M45,N45,P45," ' exhaust line
s = s & "C48" ' notes and remarks
ar = Split(s, ",")
For i = 0 To UBound(ar)
For Each cell In ws.Range(ar(i))
If cell.Value <> "" Then
rng = ws.Name
rng.Offset(, 1) = cell.Address(0, 0)
rng.Offset(, 2) = cell.Row
rng.Offset(, 3) = cell.Column
rng.Offset(, 4) = cell.Value
Set rng = rng.Offset(1)
End If
Next
Next
Debug.Print ws.Name & " Done"
End Sub
Sub scanCustomer(ws As Worksheet, ByRef rng As Range)
Dim cell As Range, ar, s As String
Dim i As Long, n As Long
' old template layout
s = "B14:B25," ' contact details
s = s & "B28:B29," ' existing install
s = s & "B32:B35," ' hook up
s = s & "A38" ' remarks
ar = Split(s, ",")
For i = 0 To UBound(ar)
For Each cell In ws.Range(ar(i))
If cell.Value <> "" Then
rng = cell.Address(0, 0)
rng.Offset(, 1) = cell.Row
rng.Offset(, 2) = cell.Column
rng.Offset(, 3) = cell.Value
Set rng = rng.Offset(1)
End If
Next
Next
Debug.Print ws.Name & " Done"
End Sub

Copy and Paste values from a Row multiple times in a Column in Excel using VBA

I'm currently working on a project on VBA that requires multiple manipulation on data.
So, the main idea of this will be to get the data that I have on "Q1" and paste it 4 times on A (starting at the first blank cell), after that, take the data from "Q2" and do the same until there is no more data on the "Q" column. After there is no more data, the process should stop.
Later on I may need to modify the process, so the value gets pasted only 2 or 3 times instead of 4.
Something like this:
Column Q data:
Expected result:
I think this will do what you want:
Option Explicit
Sub Transpose_Multiplied()
Dim Number_Of_Repetitions As Integer
Dim Input_Column As String
Dim Output_Column As String
' -----------------------------------------------------------
' These are the control variables ....
Number_Of_Repetitions = 4
Input_Column = "Q"
Output_Column = "A"
' -----------------------------------------------------------
Dim WSht As Worksheet
Dim Cell As Range
Dim LastACell As Long
Dim i As Integer
Set WSht = ActiveWorkbook.ActiveSheet
For Each Cell In WSht.Range(Input_Column & "2:" & Input_Column & WSht.Cells(WSht.Rows.Count, Input_Column).End(xlUp).Row)
For i = 1 To Number_Of_Repetitions
LastACell = WSht.Cells(WSht.Rows.Count, Output_Column).End(xlUp).Row
If LastACell = 1 And WSht.Cells(LastACell, Output_Column).Value = vbNullString Then
WSht.Cells(LastACell, Output_Column).Value = Cell.Value
Else
WSht.Cells(LastACell + 1, Output_Column).Value = Cell.Value
End If
Next
Next
End Sub
So, I open up my workbook and leave it open on the Worksheet where the data to be processed is. Then I run the macro from my PERSONAL.XLSB:

Looping through ListBox to enter values into sheet array

I would like to find the cells (or Rows) in Column B, Sheet1, who have matching values placed into ListBox2. Then, I'd like to change the value of a cell 4 columns over (using an Offset command).
I believe using a For loop is the most efficient way of going thru the values placed into ListBox2. I tried using a Forloop to go thru all values placed into ListBox2.List. Upon calling a value, the code would look for this value in Column B. Once found, it would "remember" the Row in which this value was found. Then, the code would use a Range/Offset command to change the value of a cell 4 columns over in that Row.
Private Sub ButtonOK_Click()
Dim wb As Workbook
Dim ws As Worksheet
Dim SerialList As Range
Dim SerialRow As Long
Dim i As Long
Set wb = ActiveWorkbook
Set ws = ActiveWorkbook.Worksheets("Sheet1")
Dim strFind As Variant
With ws
For i = 0 To Me.ListBox2.ListCount - 1
Set SerialList = ws.Range("B:B").Find(What:=Me.ListBox2.List(i))
SerialRow = SerialList.Row
If Not SerialList Is Nothing Then
ws.Range("B", SerialRow).Offset(0, 4).Value = Me.ListBox2.List(i) 'error occurs here!
MsgBox (ListBox2.List(i) & " found in row: " & SerialList.Row)
Else
MsgBox (ListBox2.List(i) & " not found")
End If
Next i
End With
End Sub
The MsgBoxes do say the correct ListBox2.List(i) value and the correct SerialList.Row, meaning that the program is correctly finding the row in which the list box value is located. However, I get an error saying that my range is not correctly defined at line "ws.Range("B", SerialRow)....."
How do I select the cell I'm searching for to correctly set it to =Me.ListBox2.List(i)?
Couple of fixes:
Dim lv
'....
For i = 0 To Me.ListBox2.ListCount - 1
lv = Me.ListBox2.List(i)
Set SerialList = ws.Range("B:B").Find(What:=lv, LookAt:=xlWhole) '<< be more explicit
'don't try to access SerialList.Row before checking you found a match...
If Not SerialList Is Nothing Then
ws.Cells(SerialList.Row, "F").Value = lv '<< Cells in place of Range
MsgBox (lv & " found in row: " & SerialList.Row)
Else
MsgBox (lv & " not found")
End If
Next i

VBA - Prevent the Adding of Multiple Sheets

The purpose of my macro is to allow a user to select a range in their model that they want to check for hard codes. The macro then prints the worksheet, cell address, and value of the hard code on a summary sheet. The macro currently works great if you're selecting only from one sheet; however, if you extend your selection to multiple sheets, the macro will create multiple sheets instead of just one which it is intended to do. Thank you in advance for your time and help
Set RngCon = Selection.SpecialCells(xlCellTypeConstants, xlNumbers)
Set SumWS = Worksheets.Add
Username = InputBox("Please create a name for the output sheet (i.e. Whs Industry Hard Codes)")
SumWS.Name = Username
x = 1
SumWS.Cells(x, 1) = "Worksheet"
SumWS.Cells(x, 2) = "Address"
SumWS.Cells(x, 3) = "Value"
For Each c In RngCon
x = x + 1
SumWS.Cells(x, 1) = c.Worksheet.Name
SumWS.Cells(x, 2) = c.Address(False, False)
SumWS.Cells(x, 3) = c.Value
Next c
you could do something like that:
Sub test()
Dim SumWS As Worksheet
Dim ws As Worksheet
Dim SelectedSheets() As String
Dim n As Long
Dim i As Long
n = 0
For Each ws In ActiveWindow.SelectedSheets
ReDim Preserve SelectedSheets(n)
SelectedSheets(n) = ws.Name
n = n + 1
Next
Sheets(SelectedSheets(0)).Select
Set SumWS = Worksheets.Add
Debug.Print "Sum Sheet: " & SumWS.Name
For i = LBound(SelectedSheets) To UBound(SelectedSheets)
Debug.Print "Selected Sheet #" & i & ": " & SelectedSheets(i)
Next i
End Sub
In the first for you save the selected sheets in an array. Then you can select one specific sheet and add your sum sheet. The second for shows how to work with the stored information. You can loop the selected sheets to get all values and - if needed - select them again.
credits to Siddharth Rout (Similar case)

Entereing multiple values in a single cell in excel

I want to enter multiple values in a single cell in excel sheet based on the certain condition as in if there are multiple sheets in the workbook then if any of the sheet starting with name TC contains color in it then I've to enter the information in Read Me Section of the Excel Workbook a another worksheet. The problem with my code is that its not displaying unique sheets which contain coloring...Suppose Sheet "TC_1" and "TC_3" contains color in any of the cell then its displaying the output as ";TC_3;TC_3;TC_3;" although the expected output over here is "TC_1;TC_3".
Here, is the code:
Sub ErrorInSheet()
Dim Row
Dim Names As String
Names = ""
For Row = 2 To tsheet.UsedRange.Rows.Count
For Chkcol = 1 To tsheet.UsedRange.Columns.Count
If tsheet.Cells(Row, Chkcol).Interior.ColorIndex = 3 Then
Names = Names & ";" & tsheet.Name
End If
Next
Next Row
Sheets("Read Me").Cells(13, 5).Value = Names
End Sub
Sub iterateSheets()
For Each sheet1t In Worksheets
If InStr(1, sheet1t.Name, "TC") Then
Set tsheet = sheet1t
Call ErrorInSheet
End If
Next
End Sub
I think this will work for you - I tested it and worked for me.
Sub FindErrors()
Dim sht As Worksheet, cl As Range, shtNames As String
shtNames = vbNullString
For Each sht In Worksheets
If Left$(sht.Name, 2) = "TC" Then
For Each cl In sht.UsedRange.Cells
If cl.Interior.ColorIndex = 3 Then
shtNames = IIf(shtNames = vbNullString, sht.Name, shtNames & ";" & sht.Name)
End If
Next cl
End If
Next sht
Worksheets("Read Me").Cells(13, 5) = shtNames
End Sub
Notes:
I've explicitly declared the variables
I am assuming all your sheets start with "TC" so I've used Left$ but you can use InStr if you like
I've used the ternary IIF statement to stop you getting a leading ;
I've put all the code in one Sub but you can split it out if you like

Resources