I wrote a very simple macro in Excel to remove some trailing excessive text. here is the code:
Sub remove_excess_names_from_part_number()
Dim i As Integer
Application.ScreenUpdating = False
For i = 1 To 1000
Cells(i, 3).Value = Left(Cells(i, 3).Value, 10)
Next i
Application.ScreenUpdating = True
End Sub
I cannot see how this can get any simpler and yet I am disappointed by the poor Performance of this code snippet. Doesn't VBA make some optimizations for simple code like that?
Try below code :
Column C is result Column and data is in Column A
Sub remove_excess_names_from_part_number()
Application.ScreenUpdating = False
Dim lastRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("C1:C" & lastRow).FormulaR1C1 = "=Left(RC[-2],10)"
Application.ScreenUpdating = True
End Sub
Do you really need VBA for this? If you want you can use Excel's Text To Columns
Let's say the data is like this in Excel
Select your column and Click on Data | Text To Columns
Select Fixed Width in Step 1 of 3
Set your length in Step 2 of 3. If you see below, I have set it for 10
Click Finish and you are done.
Note: If the 10th character is a SPACE then it will be truncated as in Row 2
If you still want a VBA solution then I would recommend loading the entire range in an Array as #assylias suggested and then put it back after performing the calculations.
#Santosh has also given you a suggestion when you can enter the formula in one go to all the cells. If Non VBA option is available to you then you can enter the formula in the cell manually and do an autofill as well :)
Related
I am a newbie to VBA. I have found part of my solution, but all the examples I have seen fall short of what I need.
I have up and down buttons in a VBA form, which need to show data from a filtered set. I have worked out that I can apply a filter using this code:
Dim LR As Long
LR = Range("A" & rows.Count).End(xlUp).Row
Range("A3:AM" & LR).SpecialCells(xlCellTypeVisible).Select
and this works well.
Now what I need is to go up and down that data depending on whether the up or down button was pressed, and then get the data from the corresponding row and column.
I know that I can use a For loop similar to the following:
For Each Row In Range("A1", Cells(rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible)
GWEPId = Cells(Row.Row, 1)
Grip5Status = Cells(Row.Row, 4)
Next Row
but I don't know how to do this using the first method.
If I press down, I want to go to the next filtered row, and if I press up, I want to go back to the previous filtered row.
Do I need to put all the data in an array and then go up and down from the array? Is there an easier way?
I'm unsure if I actually understand your question fully, but here is my attempt with the following assumptions:
You have an actual filter applied on the first row
You have selected an actual row in your database
Then here is a piece of code that will get you the values from a higher row
Sub GetDataMinus()
'Assign code to your button to get values one row higher
Dim FR As Long, LR As Long, X As Long
FR = ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
LR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
If ActiveCell.Row > FR Then
For X = ActiveCell.Row - 1 To FR Step -1
If Not Cells(X, 1).Rows.Hidden Then
ActiveSheet.Rows(X).Select
Debug.Print Cells(X, 1).Value 'Link the value to where you want to store it, e.g. on your userform
Debug.Print Cells(X, 4).Value 'Link the value to where you want to store it, e.g. on your userform
Exit Sub
End If
Next X
End If
End Sub
And here is a piece of code that will get you the values a row lower:
Sub GetDataPlus()
'Assign code to your button to get values one row lower
Dim FR As Long, LR As Long, X As Long
FR = ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
LR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
If ActiveCell.Row < LR Then
For X = ActiveCell.Row + 1 To LR
If Not Cells(X, 1).Rows.Hidden Then
ActiveSheet.Rows(X).Select
Debug.Print Cells(X, 1).Value 'Link the value to where you want to store it, e.g. on your userform
Debug.Print Cells(X, 4).Value 'Link the value to where you want to store it, e.g. on your userform
Exit Sub
End If
Next X
End If
End Sub
I want to make a few notes:
The code can be made more elegant, there is (long) way to extract the last visible row in a filtered range. I just didn't apply it here as I feel it doesn't add that much.
I didn't test this code on a userform but I'm sure you will be able to make the adjustments where needed.
In the code I assume you selected a row in the database. However you could also store the last used row on your userform and use that as an input. Idea?
More ways to Rome, so there might be actual better ways doing this, however this was my attempt :)
Good luck with it.
I apologize if there is already the same question asked elsewhere with an answer however I have been unable to find it so here I go.
I will also mention that I am a VBA beginner, mostly playing around with codes obtained from other people to get what I want.
I currently have data in Columns A-D, with the information in column C being the important column. Everything else should be ignored.
I have a line of text in cell C1 of sheet1. It is 25 characters long and resembles the following:
4760-000004598700000000000
I have over ~970,000 rows of data and need to pull out the information found within each of these cells into two different cells in another sheet.
I cannot simply use a formula due to the number of records (excel crashes when I try).
If using the mid function for C1, I would enter something like (C1,2,3) and (C1,5,11). (except it would be for each cell in column C)
The leading zeroes between the + or - and the beginning of the first non-zero value are of no consequence but I can fix that part on my own if need be.
Ideally the information would be pulled into an existing sheet that I have prepared, in the A and B columns. (IE:sheet2)
For example, using the text provided above, the sheet would look like:
A|B
760|-0000045987 or -45987
I have looked into array, split and mid codes but I had troubles adapting them to my situation with my limited knowledge of VBA. I am sure there is a way to do this and I would appreciate any help to come up with a solution.
Thank you in advance for your help and please let me know if you need any additional information.
It sounds like what you're after could be achieved by the Text to Columns tool. I'm not sure whether you're trying to include this as a step in an existing macro, or if this is all you want the macro to do, so I'll give you both answers.
If you're just looking to split the text at a specified point, you can use the Text to Columns tool. Highlight the cells you want to modify, then go to the Data tab and select "Text to Columns" from the "Data Tools" group.
In the Text to Columns wizard, select the "Fixed Width" radio button and click Next. On step 2, click in the data preview to add breaks where you want the data to be split - so, in the example you gave above, click between "760" and "-". Click Next again.
On step 3, you can choose the format of each column that will result from the operation. This is useful with the leading zeroes you mentioned - you can set each column to "Text". When you're ready, click Finish, and the data will be split.
You can do the same thing with VBA using a fairly simple bit of code, which can be standalone or integrated into a larger macro.
Sub RunTextToColumns()
Dim rngAll As Range
Set rngAll = Range("A1", "A970000")
rngAll.TextToColumns _
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(3, 2))
With Sheets("Sheet4").Range("A1", "A970000")
.Value = Range("A1", "A970000").Value
.Offset(0, 1).Value = Range("B1", "B970000").Value
End With
End Sub
This takes around a second to run, including the split and copying the data. Of course, the hard-coded references to ranges and worksheets are bad practice, and should be replaced with either variables or constants, but I left it this way for the sake of clarity.
How about this:
Sub GetNumbers()
Dim Cel As Range, Rng As Range, sCode As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Rng = Sheets("Sheet1").Range("C1:C" & Sheets("Sheet1").Range("C1048576").End(xlUp).Row)
For Each Cel In Rng
Sheets("Sheet2").Cells(Cel.Row, 1).Value = Mid(Cel.Value, 2, 3)
sCode = Mid(Cel.Value, 5, 11)
'Internale loop to get rid of the Zeros, reducing one-by-one
Do Until Mid(sCode, 2, 1) <> "0" And Mid(sCode, 2, 1) <> 0
sCode = Left(sCode, 1) & Right(sCode, Len(sCode) - 2)
Loop
Sheets("Sheet2").Cells(Cel.Row, 2).Value = sCode
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
I think there's an array formula thing that would do this, but I prefer the brute force approach. There are two ways to fill in the fields, with a procedure or with a function. I've done both, to illustrate them for you. As well, I've purposely used a number of ways of referencing the cells and of separating the text, to illustrate the various ways of achieving your goal.
Sub SetFields()
Dim rowcounter As Long, lastrow As Long
lastrow = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row 'get the last row in column "C"
For rowcounter = 1 To lastrow 'for each row in the range of values
'put the left part in column "D"
ActiveSheet.Range("D" & rowcounter) = FieldSplitter(ActiveSheet.Cells(rowcounter, 3).Text, True)
'and the right part in the column two over from colum "C"
ActiveSheet.Cells(rowcounter, 3).Offset(0, 2) = FieldSplitter(ActiveSheet.Cells(rowcounter, 3).Text, False)
Next rowcounter
End Sub
Function FieldSplitter(FieldText As String, boolLeft As Boolean) As String
If boolLeft Then
FieldSplitter = Mid(FieldText, 2, 3) 'one way of getting text from a string
Else
FieldSplitter = Left(Right(FieldText, 16), 5) ' another way
End If
'Another useful function is Split, as in myString = Split (fieldtext, "-")(0) This would return "4760"
End Function
I should note that there are related solutions to my question online but I've been unable to implement them into my own situation.
We have an .mdb database of all the products that we make. I've managed to take two criteria (Order type and Box), and print all records containing those two criteria to Excel. What I need in addition to that now is to print 30 boxes in one go as a basis for a bigger template. The labeling of these boxes usually increment (e.g. P1, P2...P30), and I'm struggling to see how I can increment the numeric portion of it to fit it into my code. Ideally, I'd like for the user to input the first and last box numbers in excel to represent the entire range (P1 and P30) and use those two values.
Sub Dan()
Dim order As String
Dim title As String 'initialize title
Dim palette As String 'intialize comment
Dim finalpalette As String
Dim finalrow As Integer 'initialize bottom-most row
Dim i As Integer
Dim Cntr As Integer
Dim LR As Integer
'Clears the contents of the last macro run
With Sheets("ALL.txt")
.Range(.Cells(6, 2), .Cells(725, 8)).ClearContents 'equates to (D2:F26)/ row, column ;Erase Columns for next macro
End With
title = Sheets("Sheet2").Range("B1").Value
palette = Sheets("Sheet2").Range("B2").Value
finalrow = Sheets("Sheet1").Range("A2").End(xlDown).Row
For i = 3 To finalrow
If Cells(i, 1) = title And Cells(i, 2) = palette Then
Cells(i, 5).Copy 'Copy ID
Sheets("ALL.txt").Range("B734").End(xlUp).Offset(1, 0).PasteSpecial
Range(Cells(i, 11), Cells(i, 14)).Copy
Sheets("ALL.txt").Range("C734").End(xlUp).Offset(1, 0).PasteSpecial
Range(Cells(i, 9), Cells(i, 10)).Copy
Sheets("ALL.txt").Range("G734").End(xlUp).Offset(1, 0).PasteSpecial
End If
Next i
End Sub
The variable I'm looking to adjust is 'palette'. I originally used it to match records to one Box (P1). What I need is to able to match records from 30 boxes (P1 to P30) in the loop. The variable 'palette' is just taking the static value of whatever is in cell B2 at the moment. I'm thinking there should be some way to type the first and last box into two cells to establish a range for the macro to iterate, or to write all the box numbers into a column and have 'palette' move down a cell each loop to take in a new Box value.
In an attempt to grab data from a column that has all 30 boxes written into 30 cells, I tried the following line of code
End If
palette = Sheets("Sheet2").Range("B2").Offset(, 1)
Next i
but it does not seem to be grabbing any value. It should be grabbing values from cells B2 to B31.
Here is some code that I changed (still no clue as to why you're breaking this up into 3 parts, seems like excel VBA is an extra step that complicates it).
thisworkbook.worksheets(1).cells(i,5) Use full references when learning VBA
let me know if this works, I don't know enough about your situation to know exactly what you need, other than what I can see you're trying to do.
Sub Dan()
Dim Order As String
Dim Title As String 'initialize title
Dim Palette As String 'intialize comment
Dim Fpalette As String
Dim Frow As Integer 'initialize bottom-most row
Dim i As Integer
Dim Cntr As Integer
Dim LR As Integer
Dim wsALL As Worksheet
'Clears the contents of the last macro run
With Sheets("ALL.txt")
.Range(.Cells(6, 2), .Cells(725, 8)).ClearContents 'equates to (D2:F26)/ row, column ;Erase Columns for next macro
End With
Title = Sheets("Sheet2").Range("B1").Value
Palette = Sheets("Sheet2").Range("B2").Value
Frow = Sheets("Sheet1").Range("A2").End(xlDown).Row
Set wsALL = Sheets("ALL.txt")
i = 2
Do While i < Frow
i = i + 1
If ThisWorkbook.Worksheets("Sheet1").Cells(i, 1) = Title And ThisWorkbook.Worksheets("Sheet1").Cells(i, 2) = Palette Then
Sheets("Sheet1").Cells(i, 5).Copy Destination:=wsALL.Range("B734").End(xlUp).Offset(1, 0)
'wsALL.Range("B734").End(xlUp).Offset(1, 0).PasteSpecial
Sheets("Sheet1").Range(Cells(i, 11), Cells(i, 14)).Copy Destination:=wsALL.Range("C734").End(xlUp).Offset(1, 0)
'wsALL.Range("C734").End(xlUp).Offset(1, 0).PasteSpecial
Sheets("Sheet1").Range(Cells(i, 9), Cells(i, 10)).Copy Destination:=wsALL.Range("G734").End(xlUp).Offset(1, 0)
'wsALL.Range("G734").End(xlUp).Offset(1, 0).PasteSpecial
End If
Loop
End Sub
Ignore the Below, I was going to make this way more complicated than necessary. Looking at your code, be sure to reference using
Hi Joshua,
I'm not sure I completely understand what you're trying to accomplish, adding in more details such as the first macro may help in getting you a specific answer. I think possibly VBA in Excel may not be the best way. A VBA in Access sounds possible solution. But this may be of help to you.
I know you said for an end user, It would be much more complicated on your part but I've had great success using microsoft query to import data, with the correct ODBC driver "Access Database Engine" http://www.microsoft.com/en-us/download/details.aspx?id=13255 it works great now and I use it to get data from flat files then send it to SQL based on a query, but I fought with it to get it to work you will rip your hair out and it wouldn't be portable to an end user
Having a user enter a value into a specific cell could work, i.e. put a value in A1 and VBA can check that value using:
Alpha = Cells(1,1).Value
pStart = Cells(2,1).Value 'A2
pEnd = pStart + 30
In order to prevent any issues with spaces this could be done as:
set pStart = Trim(ActiveCell(2,1).Value)
Or another way is to use data validation and give users a drop down list. https://support.office.com/en-ca/article/Create-or-remove-a-drop-down-list-5a598f31-68f9-4db7-b65e-58bb342132f7
Here is the code if for either way. Notice I've made some edits, most are not essential changes, just how I write VBA. When you use the copy -> paste command it avoids the clipboard if you say .Copy Destination:= Another comment, this would be so easy in Access simply write an SQL statement and use the append feature. You say that you have a macro before this, and after this, I would say make it one (very powerful and nice) SQL statement what is run through a user form.
I have large table with values in range H2:PIG2202. I need to compare the first rows H2:PIG2 values with all other rows values. And if there is a match in the result table it pastes just those values which matched.
Now I'm using this formula in the result table to display needed values:
=IF(sheet!H$2=sheet!H3;IF(AND(sheet!H3;ISBLANK(sheet!H3))=FALSE;sheet!H3;"");"")
The VBA code is:
Sub find()
Application.ScreenUpdating = False
Range("H2:PIG2202").FormulaR1C1 = _
"=IF('sheet'!R2C='sheet'!R[1]C,IF(AND('sheet'!R[1]C,ISBLANK('sheet'!R[1]C))=FALSE,'sheet'!R[1]C,""""),"""")"
Application.ScreenUpdating = True
End Sub
The problem is that Excel shows an error when I run this macros that there are not enough system resources.
Also I would like that in the result table would be just values, not formulas.
Is that possible to do? I have no idea how to achieve this :(
Thank you in advance!
Quick solution for your which is not sophisticated and I'm rather not proud of it (but it was quickest to prepare). Keep in mind that you are going to run it 24m times which could take several minutes, maybe an hour. Some comments inside the code.
Sub Solution()
Application.ScreenUpdating = False
'-----previous one
'Range("H2:PIG2202").FormulaR1C1 = _
"=IF('sheet'!R2C='sheet'!R[1]C,IF(AND('sheet'!R[1]C,ISBLANK('sheet'!R[1]C))=FALSE,'sheet'!R[1]C,""""),"""")"
'----- new one- inserting values- first idea, simple code
Dim Cell As Range
'run for one row first to check if it is ok! and check time needed per row
'next change range to one you expect
'next- take a cup of coffee and relax...
For Each Cell In Range("h2:PIG2")
Cell.FormulaR1C1 = _
"=IF('sheet'!R2C='sheet'!R[1]C,IF(AND('sheet'!R[1]C,ISBLANK('sheet'!R[1]C))=FALSE,'sheet'!R[1]C,""""),"""")"
Cell.Value = Cell.Value
'to trace progress in Excel status bar
Application.StatusBar = Cell.Address
Next Cell
Application.ScreenUpdating = True
End Sub
Summary: I'm taking a row of data from one sheet and pasting it into another, however the sheet would be a daily use kind of thing where new data is just entered below old data.
Problem: On each new run, 7 is consistently added to the UsedRange.Count. For example: on one run the UsedRange.Count will be 7; the next time I run through the function the count will be 14.
What I'm Looking For: Why is this the case and is there a way to help UsedRange be more accurate
-I've included the entire Function for references' sake.
Function eftGrabber()
Dim usedRows As Integer
Dim i As Integer
ChDir "\\..."
Workbooks.Open Filename:= _
"\\...\eftGrabber.xlsm"
usedRows = Sheets("EFT").UsedRange.Count
Windows("Data").Activate
Sheets("DataSheet").Range("A11").EntireRow.Copy
Windows("eftGrabber").Activate
Sheets("EFT").Range("A" & usedRows + 1).Select
ActiveSheet.Paste
i = usedRows
Do 'THIS LOOP DELETES BLANKS AFTER POSTING NEW LINES
Range("A" & i).Select
If Range("A" & i) = "" Then
ActiveCell.EntireRow.Delete
End If
i = i - 1
Loop Until i = 1
Windows("eftGrabber").Activate
ActiveWorkbook.Save
Windows("eftGrabber").Close
End Function
Let me know if I've left out any important details. Thanks in advance!
Change: usedRows = Sheets("EFT").UsedRange.Count
To: usedRows = Sheets("EFT").Range("A" & Sheets("EFT").Rows.Count).End(xlUp).Row
Where "A" can be changed to whichever row you wish to count the total number of columns.
There is a danger in using UsedRange because it factors in such things and formatted cells with no data and other things that can give you unexpected results, like if you are expecting your data to start in Range("A1"), but it really starts in another range!
I will say, however, that If you really wish to use UsedRange, your code above is still wrong to get the rows. Use this instead UsedRange.Rows.Count or to get the last absolute cell of the UsedRange, use UsedRange.SpecialCells(xlCellTypeLastCell).Row
This two line do the magic
usedCol = ThisWorkbook.ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
usedRow = ThisWorkbook.ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For more info visit Microsoft's site
http://msdn.microsoft.com/en-us/library/office/ff196157.aspx
Thanks for the discussion...
.UsedRange.Rows.Count and .UsedRange.Columns.Count work fine provided there is something in cell A1. Otherwise need to use the SpecialCells solution.
Hope this is helpful.
“UsedRange” works if you use it like this >>
x := Sheet.UsedRange.Row + Sheet.UsedRange.Rows.Count - 1;
y := Sheet.UsedRange.Column + Sheet.UsedRange.Columns.Count - 1;
Problem with SpecialCells is that you can't use it on a Protected Sheet.
Assuming you have contiguous sheet (i.e. no blank cells), and you sheet starts in A1, then I have found that
Range("A1").CurrentRegion.Rows.Count
gives the most reliable results.