I have many files in a folder,
I have my code as below, is there any way to simplified my code so I do not need to keep copy and paste the same code but just continue updating the row number?
Sub FetchData()
Dim wbSource As Workbook
Dim shSource As Worksheet
Dim shDestin As Worksheet
Application.ScreenUpdating = False
'trace file from file path on B12
Workbooks.Open Filename:=Range("B12").Value & Sheets("Sheet1").Range("A1")
Set wbSource = ActiveWorkbook
Set shSource = wbSource.Sheets("Sheet1")
'current sheet display
Set shDestin = ThisWorkbook.Sheets("Sheet1")
'shDestion.Range display at where shSource.Range: the track data frm other file (NI)
shDestin.Range("E12") = shSource.Range("C2")
shDestin.Range("F12") = shSource.Range("D2")
shDestin.Range("G12") = shSource.Range("E2")
'shDestion.Range display at where shSource.Range: the track data frm other file (PD)
shDestin.Range("N12") = shSource.Range("C3")
shDestin.Range("O12") = shSource.Range("D3")
shDestin.Range("P12") = shSource.Range("E3")
'shDestion.Range display at where shSource.Range: the track data frm other file (AU)
shDestin.Range("W12") = shSource.Range("C4")
shDestin.Range("X12") = shSource.Range("D4")
shDestin.Range("Y12") = shSource.Range("E4")
‘copy from another workbook where filepath is at B11
Workbooks.Open Filename:=Range("B11").Value & Sheets("Sheet1").Range("A4")
Set wbSource = ActiveWorkbook
Set shSource = wbSource.Sheets("Sheet1")
'current sheet display
Set shDestin = ThisWorkbook.Sheets("Sheet1")
'shDestion.Range display at where shSource.Range: the track data frm other file (NI)
shDestin.Range("E11") = shSource.Range("C2")
shDestin.Range("F11") = shSource.Range("D2")
shDestin.Range("G11") = shSource.Range("E2")
'shDestion.Range display at where shSource.Range: the track data frm other file (PD)
shDestin.Range("N11") = shSource.Range("C3")
shDestin.Range("O11") = shSource.Range("D3")
shDestin.Range("P11") = shSource.Range("E3")
'shDestion.Range display at where shSource.Range: the track data frm other file (AU)
shDestin.Range("W11") = shSource.Range("C4")
shDestin.Range("X11") = shSource.Range("D4")
shDestin.Range("Y11") = shSource.Range("E4")
wbSource.Close False
End Sub
Something like this, but it's hard to tell exactly what you're doing in the code you posted...
For example what's the Activesheet when you start this code?
Option Explicit
Sub FetchData()
Dim shDestin As Worksheet
Application.ScreenUpdating = False
Set shDestin = ThisWorkbook.Sheets("Sheet1")
CopyFileContent Range("B12").Value & shDestin.Range("A1").Value, _
shDestin, 12
CopyFileContent Range("B11").Value & shDestin.Range("A4").Value, _
shDestin, 11
End Sub
Sub CopyFileContent(filePath As String, destSheet As Worksheet, destRow As Long)
Dim wbSource As Workbook, shSource As Worksheet, rngDest As Range
Set wbSource = Workbooks.Open(Filename:=filePath)
Set shSource = wbSource.Sheets("Sheet1")
Set rngDest = destSheet.Cells(destRow, 5).Resize(1, 3)
rngDest.Value = shSource.Range("C2:E2").Value
rngDest.Offset(0, 9).Value = shSource.Range("C3:E3").Value
rngDest.Offset(0, 18).Value = shSource.Range("C4:E4").Value
wbSource.Close False
End Sub
Related
Below is the excerpt of code where the "error(more like an unwanted occurrence)" happens. My code is running in a userform (not userform1) after a command button click. The initial form shows on workbook open. The second userform - UserForm1 in the code below - is a check box that I want to present to the user upon my IF condition. When the program gets there, it opens the UserForm1, but also opens a blank grey excel workbook. The workbook cannot be closed until I close the Userformm1 interface.
Note: the second msgbox does not display until AFTER I close the userform.
I tried searching for this problem, but couldn't find the issue in regards to UserForm stuff. Thanks in advance for any help.
Private Sub CommandButton1_Click()
Dim wbName As String, wb As Workbook, ws As Worksheet
Dim sht As Worksheet
Dim myValue As Variant
Dim counter As Integer
Dim EstNumAttempt As Boolean
EstNumAttemp = False
counter = 0
Dim ThisNum As String
Dim EstNum As String
Dim CopyFromBook As Workbook
Dim CopyToWbk As Workbook
Dim ShToCopy As Worksheet
Set CopyToWbk = ThisWorkbook
Application.ScreenUpdating = False
ThisUserPath = Application.ActiveWorkbook.Path
userDataPath = ThisUserPath & "\SBNBidDataSet01112018.xlsx"
Dim StartDate As String
Dim EndDate As String
StartDate = TextBox1.Value
EndDate = TextBox2.Value
EstNum = TextBox3.Value
Set wb = Workbooks.Open(userDataPath)
Set CopyFromWbk = wb
WSCount = wb.Worksheets.Count
If EstNum <> "" Then
EstNumAttempt = True
For X = 1 To WSCount
Set ws = wb.Sheets(X)
ThisNum = ws.Cells(2, 2)
If ThisNum = EstNum Then
counter = counter + 1
Set ShToCopy = CopyFromWbk.Worksheets(X)
ShToCopy.Copy After:=CopyToWbk.Sheets(CopyToWbk.Sheets.Count)
End If
Next X
If counter = 0 Then
MsgBox " That's probably not a valid EST# in SmartBidNet"
End If
End If
If IsDate(StartDate) = True And IsDate(EndDate) = True And EstNumAttempt = False Then
MsgBox "h"
wb.Application.Visible = False
UserForm1.Show
wb.Application.Visible = True
MsgBox "h"
'BLANK GREY SHEET HERE
For X = 100 To 101
Set ws = wb.Sheets(X)
lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
'future code
Next X
End If
wb.Close
Application.ScreenUpdating = False ' from before also!
End Sub
THIS IS NOT A SOLUTION, I tested a piece of your code and here is my feedback below.
I ran just this code in a workbook named testbook.xslm and I created a form (myForm that is just a grey layout, nothing on it):
Private Sub CommandButton1_Click()
Dim wb As Workbook
Dim anotherbook As Workbook
Dim anotherbook2 As Workbook
Dim anotherbook3 As Workbook
Set wb = Workbooks.Add
Set anotherbook = wb
Set anotherbook2 = wb
Set anotherbook3 = wb
MsgBox "h"
wb.Application.Visible = False
myForm.Show
wb.Application.Visible = True
MsgBox "h"
wb.Close
Application.ScreenUpdating = False ' from before also!
End Sub
From the user standpoint:
1) testbook opens
2) click the button -> book# opens on top of testbook
3) msgbox "h" pops up
4) x out of msgbox "h" -> Both workbooks disappear (testbook and book1)
5) my grey user form pops up (its empty)
6) x out of userform
7) testbook shows again on top of the new book created which is behind it
8) msgbox "h" #2 pops up
9) x out of msgbox
10) the book# behind testbook disappears
That's it. No grey box residue. How are you closing the userforms (the first one and the second one)? obviously I used the terminate with the x. I did not add any code. So how are you closing your form with no code?
Adding the same behavior occurs if I make multiple workbook references to wb.
So this code area is not your problem . . . .
Second test, still no problems, adding worksheets, running through the number of worksheets, copying them to the testbook.
Option Explicit
Private Sub CommandButton1_Click()
Dim wb As Workbook
Dim wb2 As Workbook
Dim ws As Worksheet
Dim anotherbook As Workbook
Dim anotherbook2 As Workbook
Dim anotherbook3 As Workbook
Dim X As Double
Dim lastrow As Double
Dim thisNum As String
Set wb = Workbooks.Add
Set anotherbook = wb
Set anotherbook2 = wb
Set anotherbook3 = wb
Set wb2 = ThisWorkbook
wb.Worksheets.Add
wb.Worksheets.Add
wb.Worksheets.Add
wb.Worksheets.Add
wb.Worksheets.Add
wb.Worksheets.Add
myForm2.Show
MsgBox "h"
wb.Application.Visible = False
myForm.Show
wb.Application.Visible = True
MsgBox "h"
For X = 1 To wb.Worksheets.Count
Set ws = wb.Sheets(X)
thisNum = ws.Cells(2, 2)
lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
ws.Copy After:=wb2.Worksheets(wb2.Worksheets.Count)
'future code
Next X
wb.Close
Application.ScreenUpdating = False ' from before also!
End Sub
Perhaps you have a lot of data being acted upon. Clear the clipboard after the paste? With:
Application.CutCopyMode = False
Digging - WWC
I am using two workbooks at a time. The first workbook is the current workbook and the second will be opened while programming execution. I have made the global objects of the workbooks and worksheets. I'm having issues with using the worksheets simultaneously. The error is ERROR: object variable or with block variable, not set. I have mentioned the error in the comment in the second subroutine.
Dim WB As Workbook
Dim WB2 As Workbook
Dim WKS As Worksheet
Dim WKS2 As Worksheet
Sub Button1_Click()
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Set WB = ThisWorkbook
WB.Activate
fd.AllowMultiSelect = False
fd.Title = "Provide a title here."
fd.InitialFileName = ThisWorkbook.Path
If fd.Show() = True Then
strFile = fd.SelectedItems(1)
Set WB2 = Workbooks.Open(strFile)
Set WSK2 = WB2.Sheets("Schweitzer Analysis")
CalculateGrades
Else
MsgBox ("No file selected")
End If
End Sub
Sub CalculateGrades()
' first clear the contents where grades results can appear
clearGradesContents
Dim index As Integer ' for current sheet
Dim index2 As Integer ' for student sheet
Dim countCorrect As Integer ' to count no of correct answers
index = 2
index = 8
countCorrect = 0
' this first error here
' ERROR: object variable or with block variable not set
Set WKS = WB.ActiveSheet
Do While index <= 21
' the SECOND error shows here
If WKS.Cells(index, 2) = WKS2.Cells(index2, 3) Then
Count = Count + 1
Else
WKS.Cells(index, 5) = WKS2.Cells(index2, 3)
End If
If WKS.Cells(index, 3) = WKS2.Cells(index2, 4) Then
Count = Count + 1
Else
WKS.Cells(index, 6) = WKS2.Cells(index2, 4)
End If
index2 = index2 + 1
index = index + 1
Loop
End Sub
Sub clearGradesContents()
Range("E2:F21").Select
Selection.ClearContents
Range("I2:I3").Select
Selection.ClearContents
End Sub
EDIT: sorry for the previous answer, I hadn't seen your global declarations on top and I was sure it was because you hadn't declare it.
I think the issue is the following:
[...]
Set WB = ThisWorkbook
WB.Activate '<-- WB is the active workbook now
[...]
Set WB2 = Workbooks.Open(strFile) '<-- WB2 is the active workbook now!
Set WSK2 = WB2.Sheets("Schweitzer Analysis")
CalculateGrades '<-- going to next macro
[...]
Set WKS = WB.ActiveSheet '<-- ERROR: WB2 is the active workbook. WB can't have an active sheet if it's not the active workbook
Then of course, being WKS not correctly set, you can't execute this:
If WKS.Cells(index, 2) = WKS2.Cells(index2, 3) Then
I have no way to test it now, but I think that should be the issue.
To solve it,
If you really need WKS to be the ActiveSheet
Dim activeSheetName As String
...
Sub Button1Click()
...
Set WB = ThisWorkbook
WB.Activate
activeSheetName = WB.ActiveSheet.Name
...
End Sub
Sub CalculateGrades()
...
Set WKS = WB.Sheets(activeSheetName)
...
If you already know the name of the sheet you need
Just write:
Set WKS = WB.Sheets("your sheet")
instead of
Set WKS = WB.ActiveSheet
My code aims to import an .xls file selected by the user, and copy and paste it into my Data sheet in Book 1. This Book 1 has 2 sheets: Results and Data.
I want to run the code when I am in Results and here comes the problem.
When I run it in my Data sheet, after clearing the current sheet (Data) the file is imported and copied well.
However, when I import it when I am in the Results sheet, it comes an error according to the MsgBox Err.Description
What's wrong in the code?
Sub ImportData()
Dim customerBook As Workbook
Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim targetWorkbook As Workbook
Dim wb As Workbook
On Error Resume Next
Set wb = Application.Workbooks("Book1.xlsm")
wb.Activate
wb.Sheets("Data").Range("A1:M5000").Select
Selection.ClearContents
Sheets("Data").Select
Range("A1").Select
Set targetWorkbook = Application.ActiveWorkbook
filter = "Text files (*.xls),*.xls"
caption = "Please Select an Input File "
customerFilename = Application.GetOpenFilename(filter, , caption)
Set customerWorkbook = Application.Workbooks.Open(customerFilename)
Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.ActiveSheet
Dim sourceSheet As Worksheet
Set sourceSheet = customerWorkbook.ActiveSheet
sourceSheet.UsedRange.Copy targetSheet.Range("A1")
sourceSheet.UsedRange.Value = sourceSheet.UsedRange.Value
targetSheet.Paste
customerWorkbook.Saved = True
customerWorkbook.Close
Sheets("Results").Select
End Sub
You may try it like this...
Sub ImportData()
Dim filter As String
Dim caption As String
Dim customerFilename As Variant
Dim customerWorkbook As Workbook, targetWorkbook As Workbook
Dim targetSheet As Worksheet, sourceSheet As Worksheet
Set targetWorkbook = Application.Workbooks("Book1.xlsm")
Set targetSheet = targetWorkbook.Sheets("Data")
targetSheet.Range("A1:M5000").ClearContents
filter = "Text files (*.xls),*.xls"
caption = "Please Select an Input File "
customerFilename = Application.GetOpenFilename(filter, , caption)
If customerFilename = False Then
MsgBox "No Customer File was selected.", vbExclamation
Exit Sub
End If
Set customerWorkbook = Application.Workbooks.Open(customerFilename)
Set sourceSheet = customerWorkbook.ActiveSheet
sourceSheet.UsedRange.Copy
targetSheet.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = 0
sourceSheet.UsedRange.Value = sourceSheet.UsedRange.Value
customerWorkbook.Saved = True
customerWorkbook.Close
targetWorkbook.Sheets("Results").Select
End Sub
The following code:
wb.Sheets("Data").Range("A1:M5000").Select
Selection.ClearContents
Should be replaced with:
wb.Sheets("Data").Range("A1:M5000").ClearContents
The same goes for all similar lines. Operating on selection most often comes from macro recorder, is a very unreliable and slow method. It's dependent on currently selected range or object and non-transparent in the code, as it forces to know what is currently selected / active.
Selecting should be done only to leave selected worksheet or cell active in the end of macro operation or to perform actions on ActiveWindow.
Likewise, try to eliminate ActiveSheet:
Set targetSheet = targetWorkbook.ActiveSheet
And replace it with one of the following examples:
Set targetSheet = targetWorkbook.Worksheets(1) '1st worksheet in the file
Set targetSheet = targetWorkbook.Worksheets("myData") 'worksheet named "myData"
I don't know how it isn't working.
I have my active workbook. I want to run macros from active sheet.
1. I want to add 2 more columnes with headers . - works
2. I want to open external file, which is base in my vloop. - works
3. I want to use vloop to find my variable from active sheet in external workbook and save result in my active sheet
Sub ImpFPQ()
Application.ScreenUpdating = False
On Error Resume Next
Dim Imp_Row As Integer
Dim Imp_Col As Integer
Dim Baza1 As Workbook
Dim Baza2 As Workbook
Dim wksheet As Worksheet
Dim plik As Variant
Set wksheet = ActiveWorkbook.ActiveSheet
'add columns with names
wksheet.Columns("A:B").Insert Shift:=xlToRight
wksheet.Columns("A").Cells(1, 1) = "KOD"
wksheet.Columns("B").Cells(1, 1) = "LICZNIK"
'open file
plik = Application.GetOpenFilename(Title:="Wybierz raport")
If plik = False Then Exit Sub
Workbooks.Open Filename:=plik
Set Baza1 = ThisWorkbook 'activesheet
Set Baza2 = Workbooks(plik) 'external workbook
Set lastel = Baza2.Range("F3", Range("F3").End(xlDown)).Select
Set lookFor = Baza1.Cells(2, 4) 'aktualny subsyst do znalezienia
Set srchRange = Baza2.Sheets(1).Range("A3:lastel")
Range("A2").Value = Application.VLookup(lookFor, srchRange, 6, False)
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub
I have these columns, but rows dont have results. Can someone help me?
This should do the trick.
Sub ImpFPQ()
Application.ScreenUpdating = False
On Error Resume Next
Dim Imp_Row As Integer
Dim Imp_Col As Integer
Dim Baza1 As Workbook
Dim Baza2 As Workbook
Dim wksheet As Worksheet
Dim plik As Variant
Dim lastRow As Long
Dim lookfor As Variant
Dim srchRange As Range
Set wksheet = ActiveWorkbook.ActiveSheet
'add columns with names
wksheet.Columns("A:B").Insert Shift:=xlToRight
wksheet.Columns("A").Cells(1, 1) = "KOD"
wksheet.Columns("B").Cells(1, 1) = "LICZNIK"
'open file
plik = Application.GetOpenFilename(Title:="Wybierz raport")
If plik = False Then Exit Sub
Workbooks.Open Filename:=plik
Set Baza1 = ThisWorkbook 'activesheet
Set Baza2 = Workbooks.Open(plik) 'external workbook
With Baza2.Sheets(1)
lastRow = .Cells(.Rows.Count, 6).End(xlUp).Row
End With
lookfor = Baza1.Cells(2, 4) 'aktualny subsyst do znalezienia
Set srchRange = Baza2.Sheets(1).Range("A3:F" & lastRow)
Range("A2").Value = Application.VLookup(lookfor, srchRange, 6, False)
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub
Change this:
If plik = False Then Exit Sub
Workbooks.Open Filename:=plik
Set Baza1 = ThisWorkbook 'activesheet
Set Baza2 = Workbooks(plik) 'external workbook
To this:
If plik = False Then Exit Sub
Set Baza2 = Workbooks.Open(Filename:=plik)
Set Baza1 = ThisWorkbook 'activesheet
since plik is giving you a full filename (including a path) I don't think it can be used as an index for the Workbooks collection
See here: https://msdn.microsoft.com/en-us/vba/excel-vba/articles/workbook-object-excel
Hello I'm trying to copy columns C, R, W,X from file 1 to file 2 with below code but keep getting an error. My VBA knowledge isn't that good yet but probably has to do with the range setting? I've tried multiple ways but can't get it to work.
Am I using the right setting or should I use another action to get the specific columns?
Sub PFS()
Dim wbCopy As Workbook
Dim wsCopy As Worksheet
Dim rngCopy As Range
Dim wbPaste As Workbook
Dim wsPaste As Worksheet
Dim rngPaste As Range
Set wbPaste = ActiveWorkbook
Set wbCopy = Workbooks.Open("path to copy")
Set wsCopy = wbCopy.Worksheets("Blad1")
Set rngCopy = wsCopy.Range("d, e").EntireColumn
Set wsPaste = wbPaste.Worksheets("PFS")
Set rngPaste = wsPaste.Range("a1")
rngCopy.Copy
rngPaste.PasteSpecial
Workbooks.Application.CutCopyMode = False
Application.DisplayAlerts = False
wbCopy.Save
wbCopy.Close
End Sub
Solutions to copy entire column.
Sub copy()
Dim wb As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet
Dim wsNew As Worksheet
Set wb = ActiveWorkbook
Set ws = wb.Sheets("old")
Set wbNew = Workbooks("Book.xlsx")
Set wsNew = wbNew.Sheets("new")
ws.Columns(3).copy
wsNew.Columns(3).Insert Shift:=xlToRight
ws.Columns(18).copy
wsNew.Columns(18).Insert Shift:=xlToRight
ws.Columns(23).copy
wsNew.Columns(23).Insert Shift:=xlToRight
ws.Columns(24).copy
wsNew.Columns(24).Insert Shift:=xlToRight
Set wsNew = Nothing
Set wbNew = Nothing
Set ws = Nothing
Set wb = Nothing
End Sub