I have been writing some code to extract data from a an application and parse it to a spreadsheet.
My spreadsheet looks like this:
Scenario ClientName ClientNumber
5555 Smith s0001
6776 Charles d6666
I have this code:
Dim ObjExcel As New Excel.Application
Dim sWindow As New WinWindow
ObjExcel.Visible = False
Dim stext As String
ObjExcel.Workbooks.Open("c:\data\calcresults.xlsx")
Dim ObjWS As Excel.Worksheet = ObjExcel.Worksheets("IP")
Dim iNextRow As Integer = ObjWS.UsedRange.End(Excel.XlDirection.xlDown).Row + 1
ObjWS.Cells(iNextRow,1 ) = "d66666"
ObjWS.Cells(iNextRow, 2) = "s77898"
would like use to Column Name not index, for example:
ObjWS.Cells(iNextRow,"Scenario" ) = "new row data, first column"
any ideas how can i do this?
I am guessing by your post that you are opening a workbook and updating the same column values each time?
What you could do is name the Range in Excel by selecting the cell in the sheet and entering the name into the Name Box as follows:
Then you can manipulate as follows:
Dim r1 As Range
Set r1 = ActiveSheet.Range("Scenario")
r1.Value = "OOps, changed it!"
r1.Offset(1, 0).Value = "This is A2"
Additionally you can just refer to the range:
Dim r As Range
Set r = ActiveSheet.Range("A1")
r.Value = "gello"
You can also set the name of a range for more than one cell - i.e. multiple rows/columns. Then manipulate with:
Dim r2 As Range
Set r2 = ActiveSheet.Range("SomethingElse")
r2.Cells(1) = "Summit Else 0"
r2.Cells(2) = "Summit Else 1"
r2.Cells(3) = "Summit Else 2"
I cannot see anything wrong with just accessing row/col index.
Related
Getting the above error on the Index/Match. Will try and keep this short and sweet but I am a VBA noob. Everything that is called has data in. One thing I noticed was that RefCol (a range of numbers) has leading and trailing whitespace when I do a Debug Print. However when I tested the length of the value it returned the correct values.
I can't understand what is breaking it, I did an index match in the workbook itself and it works perfectly.
Private Sub Ref_Change()
Dim ws As Worksheet
Dim tbl As ListObject
Set ws = Worksheets("Details")
Set tbl = ws.ListObjects("Call_Log")
Dim RefCol As Range
Dim NameCol As Range
Dim PhoneCol As Range
Dim DateCol As Range
Set RefCol = tbl.ListColumns("Ref Number").DataBodyRange
Set NameCol = tbl.ListColumns("Caller Name").DataBodyRange
Set PhoneCol = tbl.ListColumns("Telephone").DataBodyRange
Set DateCol = tbl.ListColumns("Date").DataBodyRange
Me.CallDate.Value = Application.WorksheetFunction.Index(DateCol, Application.Match(Me.Ref.Value, RefCol, 0))
End Sub
Have I set this up correctly?
Thanks
Evan
As stated most likely the Match is not being found and an error is being passed to the INDEX.
Pull the MATCH out and test for the error before finding the correct cell in the data.
Private Sub Ref_Change()
Dim ws As Worksheet
Dim tbl As ListObject
Set ws = Worksheets("Details")
Set tbl = ws.ListObjects("Call_Log")
Dim RefCol As Range
Dim NameCol As Range
Dim PhoneCol As Range
Dim DateCol As Range
Set RefCol = tbl.ListColumns("Ref Number").DataBodyRange
Set NameCol = tbl.ListColumns("Caller Name").DataBodyRange
Set PhoneCol = tbl.ListColumns("Telephone").DataBodyRange
Set DateCol = tbl.ListColumns("Date").DataBodyRange
Dim mtchRow As Long
mtchRow = 0
On Error Resume Next
mtchRow = Application.WorksheetFunction.Match(Me.ref.Value, RefCol, 0)
On Error GoTo 0
If mtchRow > 0 Then
Me.CallDate.Value = DateCol.Cells(mtchRow, 1).Value
Else
MsgBox "'" & Me.ref.Value & "' not found, or lookup array is more than one column or row"
End If
End Sub
I have an issue with my VBA script which I'm not able to resolve, despite of all the researches I've made (Indeed, I tried to modify all the vba scripts which were near what I'm looking for, but it doesn't work).
Thank you very much for your help !
I have 2 sheets.
For the first one (ActiveSheet), I have a list.
For example :
Beurre
Creme fraiche
Fromage
Oeufs
Yaourts
In the second one ("Add value"), I have this list :
Chocolat
Carotte
Haricot
Fromage
Endive
I want the script to verify if the first value which is the sheet ("Add Value") exists in the ActiveSheet.
If it doesn't, it takes the second value in "Add Value" to make this verification. And so on with the other lines.
The loop has to stop when the script finds the same value. Then it does an action (MsgBox, for example).
For example, when the script researches "Chocolat" (the first line of the sheet "Add Value") in the ActiveSheet, it won't find it : it will use the second word to make this reasearch until it uses world "Fromage" which also exist in the second sheet.
It does the action (the msgbox), then quit the loop to continue with the other called macro which are in the script.
Moreover, I would like to choose the columns of the cell from "Add Value" each time I call the macro. Indeed, there will be several lists in this sheet.
Here is my macro. The issue is that I get the error 424 on the ligne If Not FindString Is Nothing Then
Public Sub Var()
Dim plage As Variant
Set plage = ActiveSheet.Range("A:A")
Dim col As Integer
Dim Ligne As Integer
Set Ligne = 2
Dim FindString As String
Set FindString = ThisWorkbook.Sheets("Add Value").Cells(Ligne, col).Value
End Sub
Sub Boucle_Ajout(col)
With plage
Do
If Not FindString Is Nothing Then
'do
Else
Ligne = Ligne + 1
End If
Loop While Not FindString Is Nothing
End With
End Sub
Then when I call the Macro, I only have to choose the column.
For example :
Call Boucle_Ajout(1)
Thank you very much for your help, because I am sick of not finding the solution.
PS : sorry for my english, I'm french.
Assuming the lines without numbers are in A1 to A5, this works:
Option Explicit
Const THECOLUMN = "A1"
Sub FindLineInOtherSheet()
Dim activeSheetRange As Range
Dim addValueRange As Range
Dim activeSheetLastRow As Integer
Dim addValueLastRow As Integer
Dim i As Integer
Dim n As Integer
Dim activeSheetCell As String
Dim addValueCell As String
'*
'* Setup
'*
Set activeSheetRange = ThisWorkbook.Sheets("activeSheet").Range(THECOLUMN)
activeSheetLastRow = findLastRow("activeSheet", THECOLUMN)
addValueLastRow = findLastRow("addValue", THECOLUMN)
'*
'* Loop through each cell in addValue for each cell in activeSheet
'*
For i = 1 To activeSheetLastRow
Set addValueRange = ThisWorkbook.Sheets("addValue").Range(THECOLUMN)
activeSheetCell = activeSheetRange.Value
For n = 1 To addValueLastRow
addValueCell = addValueRange.Value
If addValueCell = activeSheetCell Then
MsgBox ("Trouvé " & addValueCell)
End If
Set addValueRange = addValueRange.Offset(1, 0) 'Next row
Next n
Set activeSheetRange = activeSheetRange.Offset(1, 0)
Next i
End Sub
Function findLastRow(Sheetname As String, ColumnName As String) As Integer
Dim lastRow As Integer
Dim r As Range
Dim WS As Worksheet
Set WS = Worksheets(Sheetname)
lastRow = WS.UsedRange.Rows.Count
'*
'* Search backwards till we find a cell that is not empty
'*
Set r = WS.Range(ColumnName).Rows(lastRow)
While IsEmpty(r)
Set r = r.Offset(-1, 0)
Wend
lastRow = r.Row
Set WS = Nothing
findLastRow = lastRow
End Function
I'm creating a MACRO in MS Word that needs to be able to (basically) copy and paste the contents of a table in word into excel.
DISCLAIMER: This might seem like an over complication; however, the approach is required as it is a setup for more complicated processing.
Long story short, I loop through every table in the document, and then every cell in the table and place the text into a corresponding cell in an excel sheet.
I have these declarations for excel objects:
'Objects
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlRange As Excel.Range
At the bottom of my loops, I have the following code:
xlBook.Worksheets(x).Activate
Set xlRange = xlBook.ActiveSheet.Range(Chr(65 + x) & y)
xlRange.Text = tString
The last line is throwing an "object required" error. The variable tstring is defined as a string and is set earlier in the loop.
The full code:
Sub CopyTablesToExcel()
'Constants
Const COLUMN_INDEX = 1
Const ROW_INDEX = 2
'Ints
Dim x As Integer, y As Integer, z As Integer 'Counters
Dim numTables As Integer 'Number of tables in the word file
Dim numSheets As Integer 'Number of sheets in the excel file
Dim LastCell(1 To 2) As Integer 'Used to keep track of the last cell of a newly created excel table
Dim map() As Integer 'Holds a map of the table columns
'strings
Dim xlBookName As String 'Name of the excel workbook
Dim tString As String 'Temporary string
'Objects
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlRange As Excel.Range
'Initialize
Set xlBook = xlApp.Workbooks.Add
numSheets = xlBook.Worksheets.count
numTables = ActiveDocument.Tables.count
'Save the new book
xlBookName = InputBox("Enter the ticker symbol:")
xlBook.SaveAs FileName:=xlBookName
'Show the file?
xlApp.Visible = True
'Make sure there are enough sheets
If numSheets < numTables Then
For x = 1 To (numTables - numSheets)
xlBook.Worksheets.Add
numSheets = numSheets + 1
Next
End If
'Cycle through every table in the document and paste it to the worksheet
For z = 1 To numTables 'Cycle through tables
'Keep track of the last cell in the table
LastCell(COLUMN_INDEX) = ActiveDocument.Tables(z).Columns.count
LastCell(ROW_INDEX) = ActiveDocument.Tables(z).rows.count
For x = ActiveDocument.Tables(z).rows(ActiveDocument.Tables(z).rows.count).Cells.count To 1 Step -1 'Cycle through columns
'Used selections to support horizontally merged cells
ActiveDocument.Tables(z).rows(ActiveDocument.Tables(z).rows.count).Cells(x).Select
Selection.SelectColumn
For y = Selection.Cells.count To 1 Step -1 'Cycle through cells
tString = Selection.Cells(y).Range.Text
'Move the content into excel
xlBook.Worksheets(x).Activate
Set xlRange = xlBook.ActiveSheet.Range(Chr(65 + x) & y)
Debug.Print Chr(65 + x) & y 'Prints as expected
xlRange.Text = tString
Next
Next
Next
End Sub
I believe this is happening because the MACRO is failing to set the xlRange correctly. The output from debug.print is correct and is the format of "A#".
EDIT:
If Not xlRange Is Nothing Then
xlRange.Text = tString 'Still errors
End If
The above will evaluate to true but still throws the error at the marked line
I see two things:
.Text is a read only property. I would expect an an "Unable to set the text property of range object" error on this line:
xlRange.Text = tString
Change to:
xlRange.Value = tString
Also, your range assignment is probably wrong. I don't know why you are doing CHR(65) instead of simply "A", but the problem is this line:
Set xlRange = xlBook.ActiveSheet.Range(Chr(65 + x) & y)
Here you are ADDING x to 65, and then the Chr function returns whatever result that is, which could raise an error. A value of x that is greater than 25 will most likely raise an error becasue then Chr(65 + x) does not evaluate to a valid range address.
Since you clarify in the comments that you do intend to do this (e.g., "A" + 1 = "B", etc.), it would be better probably to do this, if for no other reason than it seems more legible and leverages the Excel object model in a less-ambiguous manner:
Set xlRange = xlBook.ActiveSheet.Range("A" & y).Offset(,x)
Private Sub Submit_Click()
Application.ScreenUpdating = False
Dim rangeForCode As range, rngLookupRange As range
Dim row As Integer, stock As Integer
Dim result As Integer
Dim drugCodePC As Integer
Dim qty As Integer
Dim ws As Worksheet
drugCodePC = CInt(DrugCode2.Value)
qty = CInt(Quantity.Value)
'Populating the drug name
Set ws = Worksheets("Drug Record")
ws.Select
*Set rangeForCode = ws.range("DrugCodeInventory")*
row = Application.WorksheetFunction.Match(drugCodePC, rangeForCode, 1)
Set rngLookupRange = ws.range("Inventory")
stock = Application.WorksheetFunction.VLookup(drugCodePC, rngLookupRange, 3, False)
result = stock + qty
'MsgBox (row)
ws.Cells(row + 1, 3).Value = result
Application.ScreenUpdating = True
Unload PurchaseForm
End Sub
This keeps throwing the error "method range of object _worksheet failed named range".
The error occurs at the **. I know it has something to do with the named ranged because previously, when i wrote the range of cells ie. "A1:A215" it works. I've checked the name range and it looks right. The name of the named ranged is also correct. I've tried to activate the workbook first but the error is still thrown.
The named ranged is:
= OFFSET(DrugCodeInventory!$A$2, 0, 0, COUNTA(DrugCodeInventory!$A:$A)-1,1)
I only want to select the first column in my worksheet dynamically.
If you run this in the Immediate window does it work?
application.Goto Worksheets("Drug Record").range("DrugCodeInventory")
If it doesn't run then try deleting the named range and creating a new one.
Please also try explicitly qualifying this section of your code:
Dim ws As Excel.Worksheet '<added full qualification here
drugCodePC = CInt(DrugCode2.Value)
qty = CInt(Quantity.Value)
'Populating the drug name
Set ws = Excel.thisworkbook.Worksheets("Drug Record") '<added full qualification here
ws.Select
*Set rangeForCode = ws.range("DrugCodeInventory")*
Kindly use the below isNameRngExist function which will return true when the name range "DrugCodeInventory" exist and then you can proceed with further manipulation.
Function isNameRngExist(myRng As String) As Boolean
On Error Resume Next
isNameRngExist = Len(ThisWorkbook.Names(TheName).Name) <> 0
End Function
This is the code that i have to export data to Excel.
Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
oExcel = CreateObject("Excel.Application")
oBook = oExcel.Workbooks.Add
oSheet = oBook.Worksheets(1)
oSheet.Range("A1").Value = "ID"
oSheet.Range("B1").Value = " Nome"
oSheet.Range("A1:B1").Font.Bold = True
oSheet.Range("A2").Value = CStr(Request("ID"))
oSheet.Range("B2").Value = "John"
oBook.SaveAs("C:\Book1.xlsx")
oExcel.Quit()
I can create and save the excel file, but i can't update the contents.
How can i do it?
Thanks.
You're trying to set a Range to a value, I think either you need to set a Range to an array that can contain the value(s) or you need to set a single Cell to a single value.
This link shows how to do either:
http://support.microsoft.com/kb/301982
I think you want:
oBook = oExcel.Workbooks.Open ("C:\Book1.xlsx")
When you choose Add, you are creating a new workbook.
If you are confident there are no gaps, something like this may suit:
''Last cell in column A, or first gap
oSheet.Range("a1").End(xlDown).Select
''A+1 row
oSheet.ActiveCell.Offset(1) = "a"
''A + 1 row + 1 col
oSheet.ActiveCell.Offset(1, 1) = "b"
''A + 1 row + 2 col
oSheet.ActiveCell.Offset(1, 2) = "c"
Otherwise, you may need http://support.microsoft.com/kb/142526 to determine the last cell.