Newbie trying to mix and match codes on an excel workbook that is configured to prompt a login and to allow diff Id and PW to see different sheets.
If Me.userid.Value = "admin" And Me.userpw.Value = "admin" Then MsgBox "Login Successful!", vbInformation, "Login Alert" MsgBox "Entry and use data with caution and exercise confidentiality at all times!", vbExclamation, "Critical Reminder" Unload Me Sheets("Summary Report View").Visible = True Sheets("Summary Report View").Select Sheets("Data Validation").Visible = True Sheets("Data Entry 1").Visible = True Sheets("Data Entry 2").Visible = True Sheets("Data Entry 3").Visible = True
I have this challenge not being able to copy data from other workbook (a particular worksheet called 6-9months) to this workbook that I'm working on into Data Entry 1. The condition is to pick up all rows with the name "John" in Column I and paste to my active workbook sheet named "data entry 1". I attempted to activate the codes through a button click to pick up all the rows but it doesn't seem to work.
Confirmation = MsgBox("Are you sure to removal all contents? This is not reversible", vbYesNo, "Confirmation") Select Case Confirmation Case Is = vbYes Sheets("Data Entry 2").Cells.ClearContents MsgBox "Information removed", vbInformation, "Information" Dim GCell As Range Dim Txt$, MyPath$, MyWB$, MySheet$ Dim myValue As String Dim P As Integer, Q As Integer Txt = "John" MyPath = "C:\Users\gary.tham\Desktop\" MyWB = "Book1.xlsx" 'MySheet = ActiveSheet.Name Application.ScreenUpdating = False Workbooks.Open Filename:=MyPath & MyWB lastrow = ActiveSheet.Range("A" & Rows.Count).End(x1Up).Row For i = 2 To lastrow If Cells(i, 11) = txt Then Range(Cells(i, 1), Cells(i, 13)).Select Selection.Copy P = Worksheets.Count For Q = 1 To P If ThisWorkbook.Worksheets(Q).Name = "Data Entry 2" Then Worksheets("Data Entry 2").Select ThisWorkbook.Worksheets(Q).Paste End If Next Q End If Next i Case Is = vbNo MsgBox "No Changes Made", vbInformation, "Information" End Select
The essential problem with your code is that you are working with multiple Excel files at the same time (1) the file you are opening and searching for "John" and the (2) current file from which the macro is being called and to which we are importing the data. Yet, your code does not reference the two files but merely states to search for "john" in the ActiveSheet. Furthermore, you are not telling VBA in which of the two files you want to search the currently active sheet.
So, if you are working with multiple files then you should specifically address everything and don't ask VBA to make assumptions which file or which sheet or which cell on which sheet in which file you mean. Confused? If VBA would be a person then he/she would probably also be confused. Yet, VBA just makes assumptions and you are left to wonder why the code doesn't do what you expect it to do. Hence, when working with multiple files you should use the following explicit (!) references and tell VBA exactly what you want:
Workbooks("Book1.xlsx").Worksheets("Sheet1").Cells(1, 1).Value2
or
Workbooks("Book1.xlsx").Worksheets("Sheet1").Range("A1").Value2
Having said that, I changed your code to make use of the above.
Option Explicit Sub CopyDataFromAnotherFileIfSearchTextIsFound() Dim strPath As String Dim wbkImportFile As Workbook Dim shtThisSheet As Worksheet Dim shtImportSheet As Worksheet Dim lngrow As Long Dim strSearchString As String Dim strImportFile As String 'uPPer or lOwEr cases do not matter (as it is currently setup) strSearchString = "jOHn" strImportFile = "Book1.xlsx" Set shtThisSheet = ThisWorkbook.Worksheets("Data Entry 2") 'If the import file is in the same folder as the current file ' then you could also use the following instead 'strPath = ThisWorkbook.Path strPath = "C:\tmp" '"C:Users\gary.tham\Desktop" With Application .ScreenUpdating = False .Calculation = xlCalculationManual .EnableEvents = False End With Set wbkImportFile = Workbooks.Open(Filename:=strPath & "\" & strImportFile) 'To speed up things you could also (if acceptable) open the file ' read-only without updating links to other Excel files (if there are any): 'Set wbkImportFile = Workbooks.Open(Filename:=strPath & "\" & strImportFile, ReadOnly:=True, UpdateLinks:=False) Set shtImportSheet = wbkImportFile.Worksheets("6-9months") shtThisSheet.Cells.ClearContents For lngrow = 2 To shtImportSheet.Cells(shtImportSheet.Rows.Count, "I").End(xlUp).Row If InStr(1, shtImportSheet.Cells(lngrow, "I").Value2, strSearchString, vbTextCompare) > 0 Then shtImportSheet.Range(shtImportSheet.Cells(lngrow, 1), shtImportSheet.Cells(lngrow, 13)).Copy shtThisSheet.Range("A" & shtThisSheet.Cells(shtThisSheet.Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial xlPasteAll, xlPasteSpecialOperationNone End If Next lngrow wbkImportFile.Close SaveChanges:=False With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic .EnableEvents = True End With End Sub
Note, that the above code is not an exact copy of yours. There are two changes:
(1) The sheet "Data Entry 2" in the current file (the file you are importing to) will be cleared without asking the user.
(2) The sheet "Data Entry 2" is directly referenced without the above check: if there actually is a sheet by that name in the current file.
So, don't forget to make the proper adjustments to suit your needs.
Do let me know if this solution works for you or if you have any more questions.
