I have 3 textboxes. 1st and 2nd textboxes contain approximately 40.000 to 80.000 lines of data. Each line has 6-7 characters maximum. Last checkbox has 800-1000 lines of data. These lines also has 6-7 characters. To save all these data in a single text file, I first add a time tag at beginning of each line, after a tab first textbox line written, and then second tbox, and third tbox, and then a new line. It goes on like that.
I use 3 checkboxes to understand which textboxes user wants to save. After save button clicked, this loop below starts. But it takes so long. Even user selects to save only first textbox, which means, let's say 50.000 lines, it takes almost a minute!
I tried methods like writing in a string, with a StringBuilder, with do-while loops, etc. but can't get a significant effect. I searched on internet and forum about different methods but couldn't find a way.
Is there any effective way to make it work faster?
For i = 0 To linesCount - 1
textStr.Append(timeCount & vbTab)
If (cbSaveOutput.Checked And Not tbOutput.Text = "") Then textStr.Append(tbOutput.Lines(i) & vbTab)
If (cbSaveForce.Checked And Not tbForce.Text = "") Then textStr.Append(tbForce.Lines(i) & vbTab)
If (cbSaveCrop.Checked And Not tbCroppedData.Text = "" And i < tbCroppedData.Lines.Length) Then textStr.Append(tbCroppedData.Lines(i))
textStr.Append(Environment.NewLine)
timeCount = Math.Round(timeCount + (1 / tbSampleRate.Text), 6)
ProgressBar1.Increment(1)
Next
The main problem is that you are using the Lines property over and over. Lines is not "live" data. When you get the property value, the control will get the Text property value first and then split it into a new array. You are doing that for every line in every TextBox and twice for the third TextBox. That is obviously bad. As you should ALWAYS do when using the Lines property, get it once and once only and assign the value to a variable, then use that variable over and over. There are other improvements that you could make to that code but that is the major issue and will reduce the time drastically.
Related
I have a long string of text. I want to print this in 3 columns over 2 pages in excel, using vba. e.g.:
A|B|C
-----
D|E|F
This is easy to do in ms word, I just split the page into 3 columns and print the text and it automatically goes onto the next column/page once the previous on is full. But I need to do similar in excel.
Ideas I've explored:
Having a textbox that stretches over 2 pages - splits into 3 columns, but the arrangement is:
a|c|e
b|d|f
I can't seem to find a way to put a page break within the text box.
Have 6 separate text boxes and split the text up - can't find a way of determining when one box is full so that the other can be started. Can't even determine how many lines the text takes up as characters have varying widths.
Have 6 separate large cells and split the text up - same issues as above.
Does anyone know of a way this can be overcome? I just want to replicate the behaviour of ms word.
Edit: here's the code for a textbox with columns that I can't get to page break:
Dim tb_1
Set tb_1 = jumbledwords_sheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 10, 7470, 488, 1300)
tb_1.TextFrame2.Column.Spacing = 10
tb_1.TextFrame2.Column.Number = 3
tb_1.TextFrame2.TextRange.Font.Size = 9
tb_1.TextFrame2.TextRange.Characters.Text = long_string
The stucture of long_string isn't important, and I can break it etc. to fit the solution.
I am a newbie working on my first excel vba application. One of my user forms has a text box that the user enters data into. The data is likely to be a number that has leading zeros. I am placing the input in a string and trying to format it as text but both things I tried to not work. Any help would be appreciated.
Here are the two things I tried after search on line for how to format text in VBA code
txtString.NumberFormat = "#"
txtString.Value = Format(txtString.Value,"'0")
Thanks for any help.
More detailed question:
My application has 15 user forms and a workbook with 19 sheets in it. The first 5 sheets are excel worksheets that are used as databases. There are 2 worksheets that are inventory databases (account for 2 different types of inventory), there is a worksheet that tracks orders, there is a work sheet that tracks test results for products in inventory, and there is a worksheet to track the label information that must go on order. When the order is generated the user enters a package tag which is likely to be a number with leading zeros. The entry with leading zeros is stored in the orders database correctly. A different user from generates the label information that must go on the product. To do this the application displays orders that need labels and then when the user selects the order they want to generate the label the application searches the order database to get info to put on label and places this in a variable within the module associated with the generate label user form. It gets data in this fashion from each of the other databases to have all of the label information together. It then writes these variables to the database that has the label info in it. When it does this the leading zero get stripped off. I done several searches to find ways to do this and I have tried many of them and cannot seem to get any to work. I was hoping to fix this with the format method because I have to use it with other things I pull from the database like %s. The stripping of the leading zeros occurs when I store the value in the worksheet that has the label info. It does not matter if I set the cell in the label worksheet from a variable or directly from the orders workbook the leading zeros get stripped off.
Thanks!
Assuming your input is a string. Converts string to value you can work with. Calculates how many zeros to precede with in case it is not consistent.
Sub PrecedingZeros()
Dim strng As String
Dim lng As Integer
Dim fmt As String
Dim i As Integer
With Selection
strng = .Value
lng = Len(strng)
.NumberFormat = "#"
fmt = "0"
If lng >= 2 Then
For i = 2 To lng
fmt = fmt + "0"
Next i
End If
.NumberFormat = fmt
.Value = CSng(strng)
End With
End Sub
All
Thanks for your help. I ended up prepending a "'" to the text string every time I set my internal variable and that kept the leading zeros in place. This worked so I dropped the format idea.
Thanks again!
Bruce
Very new to PQ, and I'm pretty sure it can do what I need in this situation, but I need help figuring out how to get there.
I have a timesheet report with 20 columns covering 50 rows that will need to be formatted to a word doc for uploading into a separate system. The original data in the cells range from 0 to any negative 2 digit number (ex: "-20"), but they need to be formatted to a seven-character set ending in ".00".
Examples:
0 will need to become "0000.00"
-4 will need to become "-004.00"
-25 will need to become "-025.00"
I think I should be able to use the text.insert function, but I'm not familiar enough with M Language to get it to do what I want it to do.
Any solutions/suggestions?
Here's my previous answer revisited...set up to use a function. You can just invoke the function once for each column you want to reformat. You'll just pass the name of the column you want to reformat to the function as you invoke the function each time.
Create a new blank query:
Open the new query in Advanced Editor and highlight everything in it:
Paste this over the highlighted text in the Advanced Editor:
let
FormatIt = (SourceColumn) =>
let
Base = Number.Round(SourceColumn,2)*.01,
Source = try Text.Start(Text.Range(
if Base < 7 then Text.From(Base) & "001" else
Text.From(Base),0,7),2) & Text.Range(Text.Range(
if Base < 7 then Text.From(Base) & "001" else
Text.From(Base),0,7),3,2) & "." & Text.End(Text.Range(
if Base < 7 then Text.From(Base) & "001" else
Text.From(Base),0,7),2)
otherwise "0000.00"
in
Source
in
FormatIt
...and click Done.
You'll see a new function has been created and listed in the Queries list on the left side of the screen.
Then go to your query with the columns you want to reformat (click on the name of your query that has the numbers you want to change in it, on the left side of the screen) and...
Click Invoke Custom Function
And fill out the pop-up like this:
- You can make up a different New column name than Custom.1.
- Function Query is the name of your query you are calling (the one you just created when you pasted the code)...for me, it's called Query1.
- Source Column is the column with the numbers you want to format.
...and click OK.
You can invoke this function once for each column. It will create a new formatted column for each.
You can use this formula = Text.PadStart(Text.From([Column1]),4,"0")&".00") in PQ to add new column that looks similar to your needs.
Here's an admittedly "busy" formula to do it:
= Table.AddColumn(#"Changed Type", "Custom", each Text.Start(Text.Range(if Number.Round([Column1],2)*.01 < 7 then Text.From(Number.Round([Column1],2)*.01) & "001" else Text.From(Number.Round([Column1],2)*.01),0,7),2) & Text.Range(Text.Range(if Number.Round([Column1],2)*.01 < 7 then Text.From(Number.Round([Column1],2)*.01) & "001" else Text.From(Number.Round([Column1],2)*.01),0,7),3,2) & "." & Text.End(Text.Range(if Number.Round([Column1],2)*.01 < 7 then Text.From(Number.Round([Column1],2)*.01) & "001" else Text.From(Number.Round([Column1],2)*.01),0,7),2))
It assumes your numbers that you want formatted are in Column1 to start. It creates a new column...Custom...with the formatted result.
To try it out, start with Column1 already populated and loaded into Power Query; then click the Add Column tab and then the Custom Column button, and populate the pop-up window like this:
...and click OK.
With more time, the repetitive parts could be made with variables to shorten this up a bit. This could also be turned into a function, given some time. But I don't have the time right now, so I figured I'd give you at least "something."
I'm Using Microsoft Excel 2013.
I have a lot of data that I need to separate in Excel that is in a single cell. The "Text to Columns" feature works great except for one snag.
In a single cell, I have First Name, Last Name & Email address. The last name and email addresses do not have a space between them, but the color of the names are different than the email.
Example (all caps represent colored names RGB (1, 91, 167), lowercase is the email which is just standard black text):
JOHN DOEjohndoe#acmerockets.com
So I need to put a space after DOE so that it reads:
JOHN DOE johndoe#acmerockets.com
I have about 20k rows to go through so any tips would be appreciated. I just need to get a space or something in between that last name and email so I can use the "Text to Columns" feature and split those up.
Not a complete answer, but I would do it way:
Step 1 to get rid of the formatting:
Copy all text that you have to the notepad
Then copy-paste text from Notepad to excel as text
I think this should remove all the formatting issues
Step 2 is to use VBA to grab emails. I assume that you have all your emails as lowercase. Therefore something like this should do the trick (link link2):
([a-z0-9\-_+]*#([a-z0-9\-_+].)?[a-z0-9\-_+].[a-z0-9]{2,6})
Step 3 is to exclude emails that you extracted from Step2 from your main text. Something like this via simple Excel function:
=TRIM(SUBSTITUTE(FULLTEXT,EMAIL,""))
Since you removed all the formatting in Step1, you can apply it back when you done
You can knock this out pretty quickly taking advantage of a how Font returns the Color for a set of characters that do not have the same color: it returns Null! Knowing this, you can iterate through the characters 2 at a time and find the first spot where it throws Null. You now know that the color shift is there and can spit out the pieces using Mid.
Code makes use of this behavior and IsNull to iterate through a fixed Range. Define the Range however you want to get the cells. By default it spits them out in the neighboring two columns with Offset.
Sub FindChangeInColor()
Dim rng_cell As Range
Dim i As Integer
For Each rng_cell In Range("B2:B4")
For i = 1 To Len(rng_cell.Text) - 1
If IsNull(rng_cell.Characters(i, 2).Font.Color) Then
rng_cell.Offset(0, 1) = Mid(rng_cell, 1, i)
rng_cell.Offset(0, 2) = Mid(rng_cell, i + 1)
End If
Next
Next
End Sub
Picture of ranges and results
The nice thing about this approach is that the actual colors involved don't matter. You also don't have to manually search for a switch, although that would have been the next step.
Also your neighboring cells will be blank if no color change was found, so it's decently robust against bad inputs.
Edit adds ability to change original string if you want that instead:
Sub FindChangeInColorAndAddChar()
Dim rng_cell As Range
Dim i As Integer
For Each rng_cell In Range("B2:B4")
For i = 1 To Len(rng_cell.Text) - 1
If IsNull(rng_cell.Characters(i, 2).Font.Color) Then
rng_cell = Mid(rng_cell, 1, i) & "|" & Mid(rng_cell, i + 1)
End If
Next
Next
End Sub
Picture of results again use same input as above.
I'm still writing a program in Excel VBA, and I've been stuck on a specific problem for hours. I'm trying to determine if someone is available on a specific day, but the information I'm given is for when they aren't available.
So I'm trying to write a series of for loops to compare all of this information and put it into Excel. I'm facing the issue, though, of the fact that it's quite complex:
With ActiveSheet
' Check the ID_Array and Date_Array to see if any names match
For DateIndex = 0 To MinLimit
For IDIndex = 0 To ID_Number
'If (ID_Array(IDIndex, 0) = Date_Array(DateIndex, 0)) Then
' We're going to use our column not only as a match check, but as our way of ending the cycle
For colCounter = 2 To 6
' If the date in the doc and the date in the array match, continue
If (.Cells(1, colCounter).Text = Date_Array(DateIndex, 1)) Then
For rowCounter = 2 To 11
' If the time slot in this row matches up with the time slot in the array, and the name also matches up, mark the name to be unused in this row
If (.Cells(rowCounter, 1).Text = Date_Array(DateIndex, 2)) Then
If (ID_Array(IDIndex, 0) = Date_Array(DateIndex, 0)) Then
ID_Array(IDIndex, 3) = "1"
End If
End If
' If the name has not been flagged as 1, write it down in this row
If (ID_Array(IDIndex, 3) <> "1") Then
supahotstring = ", " + ID_Array(IDIndex, 1) + " " + ID_Array(IDIndex, 2)
.Cells(rowCounter, colCounter).Value = .Cells(rowCounter, colCounter).Text + supahotstring
End If
' If the name HAS been flagged as 1, unflag it for the next row, since it might need to be written there
If (ID_Array(IDIndex, 3) = "1") Then
ID_Array(IDIndex, 3) = "0"
End If
' Now that all names can be checked for availability again, move on to the next row in this column
Next
End If
Next
'End If
Next
Next
End With
Above is the series of for loops I'm using. for reference, I use SQL to draw in the data, so everything is organized by records.
Since the possible available dates are fixed, I use the values I have set up in my Excel doc as a comparison to the dates people have put in. Basically, if someone has marked a specific timeslot on a specific day, I want to flag the record with that name as "1" so that it doesn't get marked down in that row. Then, I see if the current name is marked as "1", apply the appropriate actions, unmark it as "1" so that it can be checked again later.
However, when I run the program, a variety of problems occur: sometimes, the program will freeze up and I'll be forced to end task (I save quite often these days). Other times, when I write, it will simply write the same names in the same order in every box.
I feel like this should be a relatively easy problem to fix, but at this point I need a second opinion. I need to talk it over with someone here who's willing to look at it, and perhaps even find a way to do this without using four for loops.
It's a fairly complex program, and if you need more code for reference then I'm willing to provide it. I've tried to comment this code enough that it's fairly easy to understand. I really appreciate any help you can give.
EDIT: I cannot provide an image of expected output, but I can describe it. Imagine John Doe is going to be available on the first day, after 9:00AM. The program simply writes his name, along with every else's names, eleven time in each box.