I was given the assignment of parsing a word document form, and putting it into an Excel sheet. The code below does that with ease.. but I've recently learned I need to put that data into an Excel table instead of just the cells of a sheet.
For row = 1 To theTable.Rows.Count `until end of rows
isHeaderOrNot = theTable.Cell(row, 0).Range.Text `if first field in row is a header
If isHeaderOrNot.Contains("Section") Or isHeaderOrNot.Contains("Field") Then Continue For
keyText = theTable.Cell(row, 2).Range.Text `gets key text
valueText = theTable.Cell(row, 3).Range.Text `gets value text
cleanStringKey = Regex.Replace(keyText, Chr(7), "") `clean strings
cleanStringValue = Regex.Replace(valueText, Chr(7), "")
xlWorkSheet.Cells(1, column) = cleanStringKey `puts key in row 1 and column n
xlWorkSheet.Cells(2, column) = cleanStringValue `puts value in row 2 column n
column = column + 1 `increment column
Next
I was wondering if I would have to completely change my code in order to make it a table... In short go from
To
I am completely new to VB.net so if you could, dumb everything down as much as possible.
You can use Add method of WorkSheet.ListObject to create a new list (table).
Example
After adding reference to Microsoft.Office.Interop.Excel Add this import to the form:
Imports XL = Microsoft.Office.Interop.Excel
Then use such code to create a list:
Dim Application = New XL.Application()
Application.Visible = True
Dim book = Application.Workbooks.Add()
Dim sheet = DirectCast(book.Worksheets(1), XL.Worksheet)
sheet.Cells(1, 1) = "Product"
sheet.Cells(1, 2) = "Price"
sheet.Cells(2, 1) = "Product 1"
sheet.Cells(2, 2) = "100"
sheet.Cells(3, 1) = "Product 2"
sheet.Cells(3, 2) = "200"
sheet.Cells(4, 1) = "Product 3"
sheet.Cells(4, 2) = "300"
Dim list = sheet.ListObjects.Add( _
XL.XlListObjectSourceType.xlSrcRange, _
sheet.Range(sheet.Cells(1, 1), sheet.Cells(4, 2)), _
Type.Missing, XL.XlYesNoGuess.xlYes)
Then you will see this result:
Related
Having some trouble figuring this out. Here is the goal:
let's say I import some values with the following columns (Products, Category, Mobile, Desktop, Tablet)
Imported Values
Let's say I have a naming convention that is defined (doesn't change)
Hard defined naming convention (used for concatenation)
After clicking a button, my VBA code should be able to concatenate the Products values with the defined naming convention, based on the Yes/No criteria. Here is what I'm trying to get as the end result:
End goal after clicking VBA button
Tried a ton of things, here is an example of what I tried for Products of Category = Chocolate:
Code in Text Format:
'Example Attempt for Products that are of Category = Chocolate'
Dim chocolateOption1 As String 'Chocolate Mobile'
Dim chocolateOption2 As String 'Chocolate, Desktop'
Dim chocolateOption3 As String 'Chocolate, Tablet'
startingLine = 2 'This is just starting from the second row'
With SavedData 'Name of the open worksheet'
Do While .Cells(startingLine, 2) <> ""
If .Cells(startingLine, 2) = "Chocolate" And
.Cells(startingLine, 3) = "Yes" Then
chocolateOption1 = .Cells(startingLine, 1) &
.Cells(10,7) 'Concatenation to generate
DarkChocolate_Chocolate_Mobile'
ElseIf .Cells(startingLine, 2) = "Chocolate" And
.Cells(startingLine, 4) = "Yes" Then
chocolateOption2 = .Cells(startingLine, 1) &
.Cells(11,7) 'Concatenation to generate
DarkChocolate_Chocolate_Desktop'
ElseIf .Cells(startingLine, 2) = "Chocolate" And .Cells(startingLine, 5) = "Yes" Then
chocolateOption3 = .Cells(startingLine, 1) & .Cells(12,7)
'Concatenation to generate DarkChocolate_Chocolate_Tablet'
Else
chocolateOption1 = "Please import a valid Category and try again…"
chocolateOption2 = ""
chocolateOption3=""
End If
.Cells(startingLine, 6) = chocolateOption1
.Cells(startingLine, 6) = chocolateOption2
.Cells(startingLine, 6) = chocolateOption3
startingLine = startingLine + 1 'move to the next line once Dark
Chocolate product asset names are all generated and complete'
Loop
End With
Thank you for your help!
I would briefly like to start off with I have never touched VBA let alone excel macros until a couple days ago.
I need to transfer and convert data of 1000 rows (4 columns) from one sheet (Sheet 1) to another (Sheet 2).
A quick description of what I'm given, each row is an object, I have 4 columns.
The first one (column) is the Object ID, the second one is the Object name, the third one explain the what of the object and the final column explains the how. This is a very simplified version as explaining the entire project would be complicated.
On the second sheet, I have 6000 rows all with the object's IDs and Names however the What and How are missing.
My goal is to take the what and how of an object from this sheet, convert the wording to a form in which the second sheet accepts and make sure it gets added to the proper ID.
I have tried multiple code samples I have found online to try and select and organize into tables (arrays) the information from the first sheet, I failed miserably.
Converting the What and How
The second sheet has a very strict format in which everything can be written. In my mind (Lua is my main language), I would have a dictionary or table with all possible ways of the How/What could be written on the first sheet and checking each one to see if they match then change it to the corresponding sheet 2 format. Let me show you. (This is the what. There'd be another table for the how which I'll show below)
local MType = {
["Industrial"] = {"MILPRO : Industrial","Industrial"};
["Public Saftey"] = {"MILPRO : Public Saftey", "Public Saftey"};
["Military"] = {"MILPRO : Military","Military"};
["Paddling"] = {"Recreation : Paddling","Paddling"};
["Sporting Goods"] = {"Recreation : Sporting Goods","Sporting Goods"};
["Outdoor"] = {"Recreation : Outdoor", "Outdoor"};
["Hook & Bullet"] = {"Recreation : Hook & Bullet", "Hook & Bullet"};
["Marine"] = {"Recreation : Marine","Marine","Marina / Lodge"};
["Sailing"] = {"Recreation : Sailing","Sailing"};
["Unknown"] = {"UNKNOWN"}
}
local CType = {
["Multi-Door"] = {"Multi-Door","Multi-door"};
["Dealer & Distributor"] = {"Distributor","Dealer & Distributor"};
["Independant Specialty"] = {"Independant Specialty","Specialty"};
["OEM"] = {"OEM","OEM - VAR"};
["Internal"] = {"Internal","Sales Agency","Repairs Facility"};
["Rental"] = {"Rental / Outfitter", "Rental"};
["End User"] = {"End User"};
["Institution"] = {"Institution","Government Direct"};
["Unknown"] = {"UNKNOWN"}
}
The first position in each table (table = the curly brackets) is the format in which the second sheet accepts. The rest in the tables is how they might be written in the first sheet. (This is how I imagine this would go down. Idk the functions and limits of VBA)
Matching the Information to the Proper IDs
Every object has an ID 6 characters long ranging from 000100 to 999999. When taking information from the first sheet, I need to make sure it gets placed back in the row with the right ID in the second sheet (Note there's 1000 rows on the first sheet and 6000 on the second sheet).
Final notes: The IDs are stored as text and not numbers (If they need to change lmk). Both sheet's information are within tables. I'll probably be using this method for other similar sheet 1s. Any conversions (for the what and how) that fail should be marked down as Unknown.
A Visual Representation of the 2 Sheets
Sheet 1 Format
Sheet 2 format
We can create a 2 dimensional array to hold all the pairs of one dictionary, then check against each element using a For..Next loop.
Sub transcribe()
On Error GoTo Handler
Application.ScreenUpdating = False
Dim WS1 As Worksheet, WS2 As Worksheet
Dim ID1 As Range, ID2 As Range
'This is assuming youre working in Sheets 1 and 2
Set WS1 = Sheets(1)
Set WS2 = Sheets(2)
'This is assuming your tables are in these locations
Set ID1 = WS1.Range(WS1.Cells(1, 1), WS1.Cells(10, 1))
Set ID2 = WS2.Range(WS2.Cells(1, 1), WS2.Cells(20, 1))
Dim cellx As Range
Dim rowID1 As Integer
Dim FieldA As String, FieldB As String
Dim IDfound As Boolean
IDfound = True
Dim arrayA(1 To 10, 1) As String
arrayA(1, 0) = "MILPRO : Industrial"
arrayA(1, 1) = "Industrial"
arrayA(2, 0) = "MILPRO : Public Saftey"
arrayA(2, 1) = "Public Saftey"
'... etc. You have to complete this array with all the pairs of your dictionary of Field A
'array(X, 1) holds what you expect to find in table 1, and array(X, 0) holds what you want to write down in table 2.
Dim arrayB(1 To 9, 1) As String
arrayB(1, 0) = "Multi-Door"
arrayB(1, 1) = "Multi-Door"
arrayB(2, 0) = "Distribuitor"
arrayB(2, 1) = "Dealer & Distribuitor"
'... etc. You have to complete this array with all the pairs of your dictionary of Field B
'array(X, 1) holds what you expect to find in table 1, and array(X, 0) holds what you want to write down in table 2.
'Now we sweep each cell in Table 2
For Each cellx In ID2.Cells
'And we search its ID for a match in Table 1.
rowID1 = Application.Match(cellx.Value, ID1, 0)
If IDfound = True Then
'We then write down the values of Field A and B in the found row
FieldA = ID1.Resize(1).Offset(rowID1 - 1, 2).Value
FieldB = ID1.Resize(1).Offset(rowID1 - 1, 3).Value
'And we call a function (see below) to correct their values
cellx.Offset(0, 2).Value = corrected(FieldA, arrayA, 10)
cellx.Offset(0, 3).Value = corrected(FieldB, arrayB, 9)
Else
cellx.Offset(0, 2).Value = "ID not found"
cellx.Offset(0, 3).Value = "ID not found"
IDfound = True
End If
Next
Application.ScreenUpdating = True
Exit Sub
Handler:
IDfound = False
Resume Next
End Sub
Function corrected(Field As String, arrayX As Variant, UB As Integer) As String
'This is the dictionary-like function
Dim found As Boolean
'We sweep each element in the dictionary array until we find a match
For i = 1 To UB
If Field = arrayX(i, 1) Then
corrected = arrayX(i, 0)
found = True
Exit Function
Exit For
End If
Next
'If no match was found, we will write that down in the result
If found = False Then
corrected = Field & " - Not found in dictionary"
Exit Function
End If
'This code should never be reached, its just for foolproofing
corrected = "Error"
End Function
I am having a problem with finding duplicates in an excel column that is created via VBscript.
I currently am grabbing data from a DB opening an excel file, placing the data within and then sorting the data alphabetically ascending on column E (if this isn't needed it can easily be removed).
Now the problem that I am faced with is that I am trying to find any duplicates within that column E (Errors).
If there is a duplicate I would like to copy the duplicate and paste it into another sheet (column A) that I have created
Set oWS7 = oWB.Worksheets(7)
oWB.Sheets(7).Name = "Dups"
And in column B of oWS7 I would like to put all the corresponding column C's (accounts) from the original worksheet.
So that there would be a 1 Error to many account's ratio. If there are no duplicates I would like to have them left alone. I'm not sure how clear this is but any questions/help on this would be much appreciated.
Thanks in advance.
I'm going to make the following assumptions:
The content in the worksheet starts in the first row
The first row (and only the first row) is a header row.
There are no empty rows between header row and data rows.
The data is already sorted.
If these assumptions apply the following should work (once you put in the correct sheet number):
Set data = oWB.Sheets(...) '<-- insert correct sheet number here
j = 1
For i = 3 To data.UsedRange.Rows.Count
If data.Cells(i, 5).Value = data.Cells(i-1, 5).Value Then
oWS7.Cells(j, 1).Value = data.Cells(i, 5).Value
oWS7.Cells(j, 2).Value = data.Cells(i, 3).Value
j = j + 1
End If
Next
'How To find Repeted Cell values from source excel sheet.
Set oXL = CreateObject("Excel.application")
oXL.Visible = True
Set oWB = oXL.Workbooks.Open("ExcelFilePath")
Set oSheet = oWB.Worksheets("Sheet1") 'Source Sheet in workbook
r = oSheet.usedrange.rows.Count
c = oSheet.usedrange.columns.Count
inttotal = 0
For i = 1 To r
For j = 1 To c
If oSheet.Cells(i,j).Value = "aaaa" Then
inttotal = inttotal+1
End If
Next
Next
MsgBox inttotal
oWB.Close
oXL.Quit
I am currently using VBA to run a stored procedure and stored data that been extracted to table. Then, the VBA will query all the data in the data accordingly and put it into excel.
Here the problem, it takes so long for the VBA to extract all data (around 100k rows of data) into excel. Is there any other way to speed up the process? Below is part of my code. The one in bold is the insertion to excel code.
'Row number where data inserting starts
Do
current_sheet = owb.ActiveSheet
With current_sheet
'Insert header to worksheet in first row, ie. A1, B1, C1
For i = 0 To data_cols.GetLength(0) - 1
cell = data_cols(i, 0) & header_row_num 'Change to header_row_num
.Range(cell).Value = data_cols(i, 1)
Next i
End With
row_count = header_row_num + 1 'Change the first row count to a row after header_row_num
'Insert data to worksheet
While rs.EOF = False
With current_sheet
'Set format of specic columns before inserting data
.Columns("A").NumberFormat = "#"
.Columns("B").NumberFormat = "#"
.Columns("C").NumberFormat = "#"
.Columns("D").NumberFormat = "#"
.Columns("E").NumberFormat = "#"
.Columns("F").NumberFormat = "#"
.Columns("G").NumberFormat = "#"
.Columns("H").NumberFormat = "#"
.Columns("I").NumberFormat = "#"
.Columns("J").NumberFormat = "#"
.Columns("K").NumberFormat = "#"
.Columns("L").NumberFormat = "#"
.Columns("M").NumberFormat = "#"
.Columns("N").NumberFormat = "#"
.Columns("O").NumberFormat = "#"
.Columns("P").NumberFormat = "#"
.Columns("Q").NumberFormat = "#"
.Columns("R").NumberFormat = "#"
.Columns("S").NumberFormat = "#"
**'Start inserting data
For i = 0 To data_cols.GetLength(0) - 1
'Get the cell name
cell = data_cols(i, 0) & row_count
'Populate data to the cell
If IsDBNull(rs.Fields(data_cols(i, 2)).Value()) Then
.Range(cell).Value = " "
Else
.Range(cell).Value = rs.Fields(data_cols(i, 2)).Value()
End If
Next i
End With
rs.MoveNext()
'Indicates next row
row_count += 1**
If row_count > 60000 Then
owb.Worksheets.Add(, current_sheet)
need_new_sheet = True
Console.WriteLine("Added new sheet to workbook...")
Exit While
Else
need_new_sheet = False
End If
End While
Loop While (need_new_sheet And rs.EOF = False)
In case certain variable you need to know.
row_count = header_row_num + 1 'Change the first row count to a row after header_row_num
oxl = CreateObject("Excel.Application")
oxl.Visible = False
owb = oxl.Workbooks.Add
Dim data_cols(,) As String = {{"A", "Name", "NAME"}, _
{"B", "Age", "AGE"}} (Not real columns, example)
Any advice or thoughts would be greatly appreciate. Thanks in advance :)
Filling up 100k rows in Excel will definitely take time.
This is what you can do to minimize the time
Use oxl.ScreenUpdating = False in the beginning of the macro and set it to True in the end.
You might want to store the data in the array and then writing the array to Excel in one go in the end. This would definitely decrease the execution time
Excel 2007 onwards Excel has a row limitation of 1048576 rows so you might want to take that into consideration if you cross that limit.
Console.WriteLine("Added new sheet to workbook...") is VB.net. Use Debug.print if you are using VBA.
BTW this will not have significant effect on the speed but you can write the following code
Which is
.Columns("A").NumberFormat = "#"
.Columns("B").NumberFormat = "#"
'
'
'
.Columns("R").NumberFormat = "#"
.Columns("S").NumberFormat = "#"
as
.Columns("A:S").NumberFormat = "#"
The fastest method is CopyFromRecordset.
From MSDN :
expression.CopyFromRecordset(Data, MaxRows, MaxColumns)
expression: Required. An expression that returns a Range object.
Data: Required Variant. The name of the Recordset object to copy into
the range.
MaxRows: Optional Variant. The maximum number of records to copy onto
the worksheet. If this argument is omitted, all the records in the
Recordset object are copied.
MaxColumns: Optional Variant. The maximum number of fields to copy
onto the worksheet. If this argument is omitted, all the fields in the
Recordset object are copied.
For example, in your case just type:
Range("A2").CopyFromRecordset rs
I'm am relatively familiar with Excel and its functions, but am very new to VBA (I do however have background in MATLAB and C). Basically what I have is a sheet with a different machine populating each column header and a name of an employee populating the first column. The table contains text values of either "Train", indicating that the person in that row is trained on the equipment in the specified column, or "No", indicating that they are not. What I want to do is to make a separate sheet that has the Equipment in the first column and one column headered as "Trained". Each cell will theoretically be populated with the names of the people who are trained on the equipment for that row. I have a for loop code in VBA that successfully outputs the names into the immediate window
Function Train(Data As Range, Name As Range)
For Counter = 1 To Data.Rows.Count
If Data(Counter, 1).Value = "Train" Then
'Debug.Print Name(Counter, 1)
End If
Next Counter
End Function
but I have been unable in a few hours of searching to figure out how to display these values in a single cell. Is this possible?
Thanks in advance!
You have to choose if you want to do "For each person, for each machine", or "for each machine, for each person" first. Let say you want to go with the second idea, you could go with this pseudo code:
set wsEmployee = Worksheets("EmployeeSheet")
set wsEmployee = Worksheets("MachineSheet")
'Clear MachineSheet and add headers here
xEmployee = 2
yMachine = 2
do while (wsEmployee.Cells(1, xEmployee).Value <> "") 'or your loop way here
yEmployee = 2
trained = ""
do while (wsEmployee.Cells(yEmployee, 1).Value <> "") 'or your loop way here
if (wsEmployee.Cells(yEmployee, xEmployee).Value = "Trained") then
trained = trained & wsEmployee.Cells(yEmployee, 1).Value & ", "
end if
yEmployee = yEmployee + 1
loop
'remove the last , in the trained string
wsMachine.Cells(yMachine, 1).Value = wsEmployee.Cells(1, xEmployee).Value
wsMachine.Cells(yMachine, 2).Value = trained
yMachine = yMachine + 1
xEmployee = xEmployee + 1
loop
That's the basic idea. For better performances, I would do all these operation in some arrays and paste them in one operation.
Use the concatenation operator (&) to assemble the values into a string:
Dim names as String
names = ""
For Counter = 1 To Data.Rows.Count
If Data(Counter, 1).Value = "Train" Then
If counter = 1 Then
names = names & Name(counter, 1)
Else
names = names & "," & Name(counter, 1)
End If
End If
Next Counter
Then just place names in whatever cell you want.