I am trying to pull data from a worksheet in another workbook and it isn't working properly. I'm not getting an error in the code but it is not pulling the data from the worksheet I want but rather whatever worksheet is open when the workbook opens. I read somewhere that there is no need to activate the worksheet so I am not sure what is wrong with the following code:
Dim prfile1 As String
Dim prfile2 As String
Dim filepath As String
Dim checktotal As Integer
Dim checkrng As Range
Dim emunber As String
prfile1 = Worksheets("setup").Range("B10").Value
prfile2 = Worksheets("setup").Range("B7").Value
filepath = Worksheets("setup").Range("e10").Value
emunber = Worksheets("ReprintOld").Range("V3").Value
Workbooks.Open filepath & prfile2
Windows(prfile2).Activate
Sheets(emunber).Activate
checktotal = Workbooks(prfile2).Worksheets(emunber).Range("AE1")
With Workbooks(prfile2).Worksheets(emunber)
Set checkrng = Range(Range("U5"), Range("U" & 4 + checktotal).End(xlDown))
End With
Windows(prfile1).Activate
MsgBox emunber
MsgBox checktotal
MsgBox checkrng.Address
Related
I need to develop a excel vba application to rename over hundred pdf file...
I have excel file, column A is content in pdf, column B is new name of pdf. if pdf content match with column A, then rename to new name in column B.
but there is a error - Method or data member not found (Error 461) in Function ExtractPDFContent(pdfFile As String) As String and highlighting 'GetText'
code below
Sub RenamePDF()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = wb.Sheets("Sheet1")
Dim pdfPath As String
pdfPath = "F:\exceltest\"
Dim pdfFile As String
Dim pdfContent As String
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim i As Long
For i = 1 To lastRow
pdfFile = pdfPath & ws.Cells(i, "A").Value & ".pdf"
If Dir(pdfFile) <> "" Then
pdfContent = ExtractPDFContent(pdfFile)
If pdfContent = ws.Cells(i, "A").Value Then
Name pdfFile As pdfPath & ws.Cells(i, "B").Value & ".pdf"
End If
End If
Next i
End Sub
**Function ExtractPDFContent(pdfFile As String) As String**
Dim pdfDoc As Acrobat.CAcroPDDoc
Set pdfDoc = CreateObject("Acrobat.PDDoc")
pdfDoc.Open (pdfFile)
Dim numPages As Long
numPages = pdfDoc.GetNumPages
Dim i As Long
Dim text As String
For i = 0 To numPages - 1
text = text & pdfDoc.**GetText**(i)
Next i
pdfDoc.Close
Set pdfDoc = Nothing
ExtractPDFContent = text
End Function
i asked ChatGPT before, it said missing Acrobat in reference, then check it all still not work
I have a folder, which I need to bring in 29 files into 29 worksheets in a template wb. there are 31 total worksheets, but I need to start placing them after sheet 2.
I first place the relevant sheet names into an array:
Dim wbTemplate As Workbook: Set wbTemplate = ThisWorkbook
Dim wsInputs As Worksheet: Set wsInputs = wbTemplate.Worksheets("Inputs")
Dim strDate As String: strDate = InputBox("Please Enter Date of Data (mm/dd/yyyy) : ", Default:=Format(Now, "mm/dd/yyyy"))
Dim strFolderName As String: strFolderName = InputBox("Please Enter Data Folder Date (mm.dd.yy) Include 0's: ", Default:=Format(Now, "mm.dd.yy"))
'place wbTemplate sheet names into an array
With wbTemplate
Dim varWsName, i
Dim ws As Worksheet
ReDim varWsName(1 To Sheets.Count)
For i = 1 To Sheets.Count
Select Case ws.Name
Case "Inputs", "Data --->>>"
Case Else
ws(i) = ThisWorkbook.Sheets(i).Name
End Select
Next
.wsInputs.Range("B1").Value = strDate
.wsInputs.Range("B2").Value = strFolderName
End With
getting an object variable or with block not set on this line:
Select Case ws.Name
and then I want to know if this line will properly start placing the first file in the folder in sheet 1 after the case statement, and then second file will place in sheet 2 and so forth:
With wb.Worksheets("Sheet1")
.UsedRange.Copy Destination:=wbTemplate.Worksheets(varWsName(i))
End With
Rest of code:
Option Explicit
Sub Update_Data_And_OPR()
Dim wbTemplate As Workbook: Set wbTemplate = ThisWorkbook
Dim wsInputs As Worksheet: Set wsInputs = wbTemplate.Worksheets("Inputs")
Dim strDate As String: strDate = InputBox("Please Enter Date of Data (mm/dd/yyyy) : ", Default:=Format(Now, "mm/dd/yyyy"))
Dim strFolderName As String: strFolderName = InputBox("Please Enter Data Folder Date (mm.dd.yy) Include 0's: ", Default:=Format(Now, "mm.dd.yy"))
'place wbTemplate sheet names into an array
With wbTemplate
Dim varWsName, i
Dim ws As Worksheet
ReDim varWsName(1 To Sheets.Count)
For i = 1 To Sheets.Count
Select Case ws.Name
Case "Inputs", "Data --->>>"
Case Else
ws(i) = ThisWorkbook.Sheets(i).Name
End Select
Next
.wsInputs.Range("B1").Value = strDate
.wsInputs.Range("B2").Value = strFolderName
End With
'compile all files in folder into wbTemplate
Dim filePath As String: filePath = strFolderName & "*.xlsx"
Dim fileName As String: fileName = Dir(filePath)
Dim wb As Workbook
Dim k As Long
Do While fileName <> ""
Set wb = Workbooks.Open(strFolderName & fileName)
With wb.Worksheets("Sheet1")
.UsedRange.Copy Destination:=wbTemplate.Worksheets(varWsName(i))
End With
wb.Close
fileName = Dir
Loop
End Sub
I am attempting to consolidate data from multiple workbooks into one Master workbook. All workbooks, including the master workbook, have the same worksheets. The data in the worksheets, however, is different. Each workbook is created from asking the same survey questions. I am looking to consolidate all survey answers into one workbook.
Code:
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim lastRowNumber As Double
Dim lastColumnNumber As Double
Dim theLastCell As String
Dim copyRange As Range
Dim pasteRange As Range
Dim sheetName As String
Dim copyRangeString As String
Dim pasteRangeString As String
Do While myFile <> ""
Set wb = Workbooks.Open(FileName:=myPath & myFile)
DoEvents
wb.Worksheets(1).Range("A2:D2").Interior.color = RGB(51, 98, 174)
For i = 1 To 8
lastRowNumber = lastRowUsed(wb.Sheets(i))
lastColumnNumber = wb.Sheets(i).Range("A1").SpecialCells(xlCellTypeLastCell).Column
theLastCell = Cells(lastRowNumber, lastColumnNumber).Address(RowAbsolute:=False, ColumnAbsolute:=False)
Set copyRange = wb.Worksheets(i).Range("A2:" & theLastCell)
copyRangeString = "A2:" & theLastCell
lastRowNumber = lastRowUsed(theWorkbook.Sheets(i)) + lastRowUsed(wb.Sheets(i))
pasteRangeString = "A" & lastRowNumber & ":" & theLastCell
theWorkbook.Sheets(i).Range(pasteRangeString) = wb.Sheets(i).Range(copyRangeString).value
copyRangeString = ""
pasteRangeString = ""
sheetName = wb.Sheets(i).name
MsgBox sheetName
Next
wb.Close
DoEvents
myFile = dir
Loop
I am trying to accomplish this by looping through each Excel file in a folder, looping through (1-8) of the worksheets. Creating a range of the data in each worksheet, and then copying and pasting into the theWorkbook "master" workbook. For whatever reason, only data from the last workbook in the folder is getting copied.
Any and all help is much appreciated!
I am trying to fill an ActiveX Combobox with a dynamic range from another workbook but I am getting a run-time error '1004' Application or object-defined error on the line of code that assigns the range:
Dim prfile1 As String
Dim prfile2 As String
Dim filepath As String
Dim checktotal As Integer
Dim checkrng As Range
Dim emunber As String
prfile1 = Worksheets("setup").Range("B10").Value
prfile2 = Worksheets("setup").Range("B7").Value
filepath = Worksheets("setup").Range("e10").Value
emunber = Worksheets("ReprintOld").Range("V3").Value
Workbooks.Open filepath & prfile2
Windows(prfile2).Activate
checktotal = Workbooks(prfile2).Worksheets(emunber).Range("AE1")
checkrng = Workbooks(prfile2).Worksheets(emunber).Range(Range("U5"), Range("U5").End(xlDown))
You need to qualify all your Range objects.
checktotal = Workbooks(prfile2).Worksheets(emunber).Range("AE1")
With Workbooks(prfile2).Worksheets(emunber)
Set checkrng = .Range(.Range("U5"), .Range("U5").End(xlDown))
end with
I keep getting a 'Method 'SaveAS' of object '_Workbook' failed, I can't for the life of me figure out why. Code below... any recommendation unrelated to the initial question are welcome!
Private Sub CommandButton1_Click()
'Declarations
'The two workbooks to be involved
Dim SourceWB As Workbook
Dim DestinationWB As Workbook
'values to contain cell data to be copied across the worksheet
Dim systemName As Variant
Dim systemID As Variant
'Counter variable to allow for the loop
Dim counter As Integer
'Set the source workbook equal to the current workbook
Set SourceWB = ActiveWorkbook
For counter = 1 To 5
'Set the values for the two data values to be copied
systemName = SourceWB.Sheets("Sheet1").Cells(counter, 1).Value
systemID = SourceWB.Sheets("Sheet1").Cells(counter, 2).Value
'Open the destination Workbook
Set DestinationWB = Workbooks.Open("Path to workbook")
'Set destination cells equal to the copied data from the source sheet
DestinationWB.Sheets("Questionnaire").Cells(7, 3).Value = systemName
DestinationWB.Sheets("Questionnaire").Cells(8, 3).Value = systemID
'Set fname to save Destination Workbook
Fname = "H:\Desktop\Automated Questionnaires to send\" & systemName & " Applicability Questionnaire.xlsm"
'Save the Destination workbook
DestinationWB.SaveAs Filename:=Fname, FileFormat:=52
DestinationWB.Close
Next counter
End Sub