I am trying to transfer number of content controls to excel spreadsheet. The issue is, I would only like to transfer words which were selected by used with bold. I would appreciate any help.
I have already tried to adopt one of your workflows but I am stuck.
Dim txtboxstring As Characters
Dim CharacterFont As Font
Dim counter As Integer
(...)
ElseIf C_C.Title = "Data_Sheet_Structural_Type" Then
Workbooks(DES_Bridges_WrkBook).Sheets(DES_Bridges_WrkSheet).Cells(i, 17).Value = C_C.Range.Text
'Test for bold text
ElseIf C_C.Title = "Data_Sheet_Material" Then
Set textboxstring = C_C.Range.Characters
For counter = 1 To textboxstring.Count
CharacterFont = textboxstring.Font
If CharacterFont.Bold Then
BoldFound = BoldFound & txtboxstring(counter)
End If
Next counter
Workbooks(DES_Bridges_WrkBook).Sheets(DES_Bridges_WrkSheet).Cells(i, 18).Value = BoldFound
BoldFound = ""
ElseIf C_C.Title = "Deck_Width" Then
Workbooks(DES_Bridges_WrkBook).Sheets(DES_Bridges_WrkSheet).Cells(i, 19).Value = C_C.Range.Text
(...)
I get following error:
Objec doesnt support Property or Method
in line
CharacterFont = textboxstring.Font
I would appreciate any help.
Related
I have been following a tutorial and playing with developing Fully Automated User Data Entry Form.
The Video I followed PSB:
https://www.youtube.com/watch?v=P53T6oxgUVA&ab_channel=TheDataLabs
After having downloaded his files and gone through the code step by step, I still get a yellow highlight over the particular section of the ELSE statement on the Sub Clear()? Additionally my Listbox does not update correctly it replaces the previous entry with the next entry saved.
Please view the code below
Sub Clear()
Dim iRow As Long
iRow = [Counta(Room Access 2!A:A)] '''Identify Last Row as per tutorial''
With Frm_Room_Access_2
.Surname_Txtbx.Value = ""
.Rank_Cmbobx.Value = ""
.Section_Txtbx.Value = ""
.Extention_Txtbx.Value = ""
.Service_Number_Txtbx.Value = ""
.Due_Time_Txtbx.Value = ""
.OpBtn_Time_as_Now.Value = False
.SerialNo_Txtbx.Value = ""
If iRow > 1 Then
.List_Database.RowSource = "Room Access 2!A2:G" & iRow
Else
.List_Database.RowSource = "Room Access 2!A2:G" '''' Keeps Highlighting Error ''''
End If
End With
End Sub
Sub Submit()
Dim sh As Worksheet
Dim iRow As Long
Set sh = ThisWorkbook.Sheets("Room Access 2")
If Frm_Room_Access_2.SerialNo_Txtbx.Value = "" Then
iRow = [Counta(Room Access 2!A:A)] + 1
Else
iRow = Frm_Room_Access_2.SerialNo_Txtbx.Value
End If
With sh
.Cells(iRow, 1) = iRow - 1
.Cells(iRow, 2) = Frm_Room_Access_2.Surname_Txtbx.Value
.Cells(iRow, 3) = Frm_Room_Access_2.Service_Number_Txtbx.Value
.Cells(iRow, 4) = Frm_Room_Access_2.Rank_Cmbobx.Value
.Cells(iRow, 5) = Frm_Room_Access_2.Section_Txtbx.Value
.Cells(iRow, 6) = Frm_Room_Access_2.Extention_Txtbx.Value
.Cells(iRow, 7) = IIf(Frm_Room_Access_2.OpBtn_Time_as_Now.Value = True And Frm_Room_Access_2.Due_Time_Txtbx.Value = "", Now(), Frm_Room_Access_2.Due_Time_Txtbx.Value)
End With
End Sub
The Issues that I want to resolve is firstly why is my list box not adding another entry under the first entry, it simply replaces the first entry upon saving. Do I require another method for this?
Secondly why is the code Highlighting that the Else Statement is incorrect despite following the tutorial and replicating the code correctly to my particular needs.
Any advice will be greatly appreciated.
The last cell with text in a column can be found with
Range("B" & 1).End(xlDown).Offset(1, 0).Select
The Offset(1, 0) selects the cell below in order for you to copy data to it.
To select a worksheet use:
Worksheets("Room Access 2").Select
No underlines are needed.
I have to display an excel sheet on a ListBox in VB.net. So far I have been able to display the first column. I have used zones to format two columns. Here is my code for this part:
Dim fmtStr As String = "{0,15}, {1,15}"
I then have this code for displaying in the ListBox:
For i = 0 To AscW(ListBox1.Items.Count.ToString()(i = i + 1)) - 1
cella = "A" & Convert.ToString(i + 1)
cellb = "B" & Convert.ToString(i + 1)
cella = aSheet.Range(cella).Value
cellb = aSheet.Range(cellb).Value
ListBox1.Items.Add(String.Format(fmtStr, "1", "2"))
If cella = "" Or cellb = "" Then
ListBox1.Items.Add("")
Else
ListBox1.Items.Add(String.Format(fmtStr, cella, cellb))
End If
I'm getting errors while running.. Is there another method to display the columns side by side ?
UPDATE: Everything is working fine but the output is messy like so:
Image
ListBox1.Font = New System.Drawing.Font("Consolas", 8.25!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
So a client has a bunch of data stored in Excel sheets that we want to bring into a database, and one component of the data is that it is color-coded. In this case there are model numbers for various equipment with the brand having been recorded by coloring the text. (Different colors represent different brands. The color code number used is always consistent with a certain brand.) Here's an example of a given cell:
[Each cell could contain one model, multiple models separated by commas, or nothing.]
If I just export the above as CSV, I'll get:
...,"4100, 4500, 4600",...
Which as you'd expect, discards all the color information.
Can you think of any way to run an Excel Macro or such that would add this color data as textual tags in the cells - so that the color "data" is being "tagged" in the cell instead? Such as something like this:
Because I'd like to end up with something like this in the CSV export:
...,"<typeG>4100</typeG>, <typeR>4500</typeR>, <typeB>4600</typeB>",...
Or even just something like:
...,"[green]4100, [red]4500, [blue]4600",...
The exact formatting style in the CSV isn't crucial, as I can post-process this later.
Reason for this is I need to be able to export these Excel files to CSV, and then import them into a database (using customized import code). (Each model record will then be getting its own data record, with the brand being relationally specified as an ID. Just for context to understand the why.) The later part I can figure out, I just need to be able to figure out how to automatically tag the models somehow by their color in a CSV.
I finally figured this out. I needed to split the models to an array, determine the character position in the cell of the items in the array, check the Font.Color of those characters, and then adjust the array items with their appropriate tag, and then put the updated array contents back into the cell.
Here's the code:
Sub TagModelsWithBrand()
On Error GoTo ErrHandler:
' Set your range to process
Set modelRange = Worksheets("Sheet1").range("B2:M18")
' Brands and Color for each
Const b_1 = "[green]"
Const b_1c = 32768
Const b_2 = "[red]"
Const b_2c = 255
Const b_3 = "[blue]"
Const b_3c = 16711680
Const b_99 = "[Unknown]"
Dim rangeCell As range
Dim charPosition As Integer
Dim modelArray() As String
Dim charColor As Variant
Dim brand As Integer
charPosition = 0
For Each rangeCell In modelRange
If Len(rangeCell.Text > 0) Then
modelArray = Split(rangeCell.Text, ",")
For m = 0 To UBound(modelArray)
For i = charPosition + 2 To charPosition + Len(modelArray(m))
charColor = rangeCell.Characters(i, 1).Font.Color
charPosition = charPosition + 1
If charColor = b_1c Then
brand = 1
ElseIf charColor = b_2c Then
brand = 2
ElseIf charColor = b_3c Then
brand = 3
Else
brand = 99
End If
Next i
modelArray(m) = Replace(modelArray(m), " ", "") ' Remove any spaces
If brand = 1 Then
modelArray(m) = b_1 & modelArray(m)
ElseIf brand = 2 Then
modelArray(m) = b_2 & modelArray(m)
ElseIf brand = 3 Then
modelArray(m) = b_3 & modelArray(m)
Else
modelArray(m) = b_99 & modelArray(m)
End If
brand = 0
Next m
charPosition = 0
rangeCell.Value = Join(modelArray, ",")
rangeCell.Font.Color = 1
End If
Next rangeCell
MsgBox "Done Tagging Models"
Exit Sub
ErrHandler:
MsgBox "Error occurred"
Resume Next
End Sub
I've hardly touched Visual Basic for years and years, so I suspect there's better ways of doing this, but at least this works - much better than doing it by hand!
I'm looking at my CSV sheet for a check (from my checking account) to compare with another sheet called checking. I want to match checks up. I'm balancing the bank statement. "A" is the value but I also want to store the values to the left of this (the description.)
I used a double nested "FOR" statement to accomplish this, with the first "FOR" shown here. In the CSV list, the first one is:
Description= Citgo
A= 1.53
next is:
Description = MCD
A = 2.42
When I run the below I get
a= 1.53
Description: Citgo
Then, as the FOR loops I get:
A=2.42
Description = Citgo (it should be MCD - it's not incrementing.)
How do I correct this?
Sheets("CSV").Select
Set ShtCSV = ActiveSheet
Range("a499").End(xlUp).Select
Set CSVBottomLeft_A = Selection
Range("d150").End(xlUp).Select
Set CSVBottomRight_D = Selection
Range("d2", CSVBottomRight_D).Select
Set CSVSelection_Area = Selection
'Range("A1").Select
'''''''''''''''''''''''''''
Sheets("matrix").Select
Set ShtMx = ActiveSheet
'''''''''''''''''''''''''''
Sheets("checking").Select
Set ShtChecking = ActiveSheet
Range("e499").End(xlUp).Select
BottomChecks_E = Selection.Address
Set CheckArea = Range("E5", BottomChecks_E)
Range("d499").End(xlUp).Select
BottomDeposites_D = Selection.Address
Set DepositeArea = Range("d5", BottomDeposites_D)
Range("c499").End(xlUp).Select
ML 1
Set BottomLeft_B = Selection
Range("g499").End(xlUp).Select
Set BottomRight_G = Selection
Range("B5", BottomRight_G).Select
Set CheckSelection_Area = Selection
ShtCSV.Select
For Each A In CSVSelection_Area 'For-1
ShtCSV.Select
CSV = A
CSVDescription = ActiveCell.Offset(0, -1).value 'left 1
CSVChkNumber = ActiveCell.Offset(0, -2).value
CSVDate = ActiveCell.Offset(0, -3).value
MsgBox A
MsgBox CSVDescription
next
Using ActiveCell refers to the ActiveWorkSheet whereas you want to refer to your A Range. Try it like this instead
CSVDescription = A.Offset(0, -1).value 'left 1
CSVChkNumber = A.Offset(0, -2).value
CSVDate = A.Offset(0, -3).value
I am new to selenium VBA and post googling have crated the below code in order to bring the each cell value from a dynamic webpage using the selenium vba. I am getting error in receiving the web elements in a web_tr and web_td web elements
Have trying with this line:
ActiveSheet.Cells(i, 1).Value = selenium.findElementByXPath("//table[#id='ctl00_cphContentBody_itemsTable']/tbody/tr['i']/td[1]").Text
I am getting a header line item first value only though it is under the loop.
Web_tr and web_td are web elements and receiving the web elements to these variables are the issue here. Kindly assist.
With ThisWorkbook
.Sheets("UpfrontOrder#").Activate
Set web_table = selenium.findElementsByXPath("//table[#id='ctl00_cphContentBody_itemsTable']/tbody")
Set web_tr = web_table.findElementsByTagName("tr") '***** the error pop-up gets in here****
row_count = selenium.findElementsByXPath("//table[#id='ctl00_cphContentBody_itemsTable']/tbody/tr").Count
For i = 1 To row_count
Set web_td = web_tr.findElementsByTagName("td")
ActiveSheet.Cells(i, 1).Value = web_td(1).getText
'ActiveSheet.Cells(i, 1).Value = selenium.findElementByXPath("//table[#id='ctl00_cphContentBody_itemsTable']/tbody/tr['i']/td[1]").Text
ActiveSheet.Cells(i, 2).Value = selenium.findElementByXPath("//table[#id='ctl00_cphContentBody_itemsTable']/tbody/tr['i']/td[2]").Text
ActiveSheet.Cells(i, 3).Value = selenium.findElementByXPath("//table[#id='ctl00_cphContentBody_itemsTable']/tbody/tr['i']/td[3]").Text
ActiveSheet.Cells(i, 4).Value = selenium.findElementByXPath("//table[#id='ctl00_cphContentBody_itemsTable']/tbody/tr['i']/td[4]").Text
ActiveSheet.Cells(i, 5).Value = selenium.findElementByXPath("//table[#id='ctl00_cphContentBody_itemsTable']/tbody/tr['i']/td[5]").Text
ActiveSheet.Cells(i, 6).Value = selenium.findElementByXPath("//table[#id='ctl00_cphContentBody_itemsTable']/tbody/tr['i']/td[6]").Text
ActiveSheet.Cells(i, 7).Value = selenium.findElementByXPath("//table[#id='ctl00_cphContentBody_itemsTable']/tbody/tr['i']/td[7]").Text
'ActiveSheet.Cells(i, 1).Value = web_td.findElementByXPath("td[1]").Text
'ActiveSheet.Cells(i, 2).Value = web_td(1).Text
Next i
End With
I'm not really familiar with the VBA version of Selenium but from what I can tell, I see one issue that I think is causing the error you are getting. When you use .findElements* (plural), it will return a collection of elements instead of just a single element. Your first line (below) is using .findElements() but in the second line (below) is not specifying which element of the web_table collection to reference.
Set web_table = selenium.findElementsByXPath("//table[#id='ctl00_cphContentBody_itemsTable']/tbody")
Set web_tr = web_table.findElementsByTagName("tr") '***** the error pop-up gets in here****
You can try to do one of two fixes...
Change .findElements() to .findElement() so that you only grab the first (and probably only?) table. If you only want the first one, this is the right way to fix this.
Add an index into the collection of elements from the first line, e.g. change web_table. to web_table(1). If you want a TABLE tag other than the first one, then add the correct reference.
Set web_table = selenium.findElementsByXPath("//table[#id='ctl00_cphContentBody_itemsTable']/tbody")
Set web_tr = web_table(1).findElementsByTagName("tr")
add this _____________^^^
Additional Note:
I had another suggestion to simplify some of your code. In your For i loop you have hardcoded indexes 2-7 where I think you can easily use a loop. I updated the code below. This accomplishes two things...
It eliminates the repeated scraping of the page. In your original code, you are scraping one element at a time. In the code below, I grab a collection of TDs and then iterate through them. That way I'm only scraping the page once to get all the elements I care about and then processing that collection. It's more efficient.
Simplifies the code.
For i = 1 To row_count
Set web_td = web_tr.findElementsByTagName("td")
ActiveSheet.Cells(i, 1).Value = web_td(1).getText
Dim tds As New List
Set tds = ActiveSheet.Cells(i, 2).Value = selenium.findElementByXPath("//table[#id='ctl00_cphContentBody_itemsTable']/tbody/tr['i']")
For j = 2 To 7
ActiveSheet.Cells(i, j).Value = tds(j).Text
Next j
Next i
Thank you both of you.
The below code works well in finding the each cell values.
With ThisWorkbook
.Sheets("UpfrontOrder#").Activate
Set web_table = selenium.findElementByXPath("//table[#id='ctl00_cphContentBody_itemsTable']/tbody")
Set web_tr = web_table.findElementsByTagName("tr")
row_count = selenium.findElementsByXPath("//table[#id='ctl00_cphContentBody_itemsTable']/tbody/tr").Count
For i = 0 To (row_count - 2)
Set web_td = web_tr(i).findElementsByTagName("td")
For j = 0 To 6
ActiveSheet.Cells((i + 1), (j + 1)).Value = web_td(j).Text
Next j
Next i
End With