I am trying to create a dynamic named range that I can use for a data validation list. I use these all time but in this case I have information that is housed below the range that cannot be counted in the range. Also, I have a macro that insert rows within this range that do need to be counted.
I normally would use something like this if nothing else was in the column: =OFFSET($A$1,0,0,COUNTA($A:$A),1)
I need to start this one down the page a little ways so I used:
=OFFSET($A$24,0,0,COUNTA($A$24:$A24),1)
Notice I have removed the "$" before the last "24" in the formula hoping it would expand accordingly, but that does not seem to be consistent.
Basically, I need the COUNTA range to only include a range of cells that will always be growing and shrinking.
I'm not bad in VBA and am open to a solution that might include looping through a range of cells and stopping once it reaches a cell that's value equals a certain text string (in the case in would be .Value = "Request 1"). But I am a little apprehensive about feeding a form or ActiveX Control, as this has caused me issues in the past with viewing and printing functionality.
I used a the following code to create a range elsewhere in the workbook that I could then easily use to create a dynamic named range:
Sub UpdateEntities()
Dim i As Long, x As Long
i = 24
x = 1
Sheets("Values").Range("AH:AH").ClearContents
Do While Cells(i, 1).Value <> "REQUEST 1"
Cells(i, 1).Select
If ActiveCell.Value <> "" Then
Sheets("Values").Cells(x, 34).Value = ActiveCell.Value
i = i + 1
x = x + 1
Else
i = i + 1
End If
Loop
End Sub
Related
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 have two columns with random times and the times come from two different sources so the columns do not have the same amount of data points. I want to start with the first time in the first column and compare it to each time in the second column. If there is a match in times, I would like to pull relevant data. After a match is found (if there is one) I would like for the code to go to the second cell in the first column and compare it to every value in the second column and so on.
Here is the code I have so far:
Sub TransferInfo()
'Activate the Sub to Convert and Format Dates
Call ConvertDates
'Define Variables
Dim st As Worksheet
Dim ts As Worksheet
Dim lastrow As Long
Dim i As Integer
j = 2
'Find and set the last used row
Set st = ThisWorkbook.Worksheets("Data Table")
lastrow = st.Cells(st.Rows.Count, "B").End(xlUp).Row
Set ts = ThisWorkbook.Worksheets("ShopFloor")
'Cycle through/compare Row J, Column 18 based on each cell in Row I, Column 14
For i = 2 To lastrow
Do Until IsEmpty(ts.Cells(j, 8)) Or IsEmpty(st.Cells(j, 2))
If st.Cells(i, 14).Value = ts.Cells(j, 18).Value Then
st.Cells(i, 15).Value = ts.Cells(j, 2).Value
Exit Do
Else
st.Cells(i, 15).Value = ""
End If
j = j + 1
Loop
j = 2
Next i
End Sub
The other sub that I call at the beginning of this sub simply rounds the times in each column to the nearest 15 minute interval to increase the likelihood of matches between the columns.
My question is: The code does not copy and paste any more information although there are times that match between the two columns. Why would the code that I have not work? Also, with larger data sets I am afraid that this the code may crash Excel and because I have a loop within a loop trying to process a lot of data a lot of times, but I don't know of a more efficient way to accomplish what I am trying to without this code.
If anyone has any insights as to why this code doesn't work I would greatly appreciate any help.
Thanks!
Based on your code, it looks like you just need an INDEX/MATCH formula. Use this in O2 and copy down:
=IFERROR(INDEX(B:B,MATCH(N2,R:R,0)),"")
No need for VBA
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 create a VB program to automatically update a Gantt chart for a group project. But now the team wants to add a new colum. The problem is that adding a new column will change my code and make it unusable. Rows can be added without changing the code, but I would have to update all my code if new colums are added. How can I add a column without chaning my VB code?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim StartDate_Row As Integer
Dim Total_Weeks As Integer
Dim Date_Week_Column As Integer
Dim Number_of_Weeks As Integer
Dim Date_Week_Column_Color As Integer
StartDate_Row = 10
Date_Week_Column = 8
Range("H9:AN25").Interior.Color = xlNone
Do
For Total_Weeks = 1 To 33
If Cells(StartDate_Row, 5).Value = Cells(8, Date_Week_Column).Value Then
Date_Week_Column_Color = Date_Week_Column
For Number_of_Weeks = 1 To Cells(StartDate_Row, 6).Value
If Cells(StartDate_Row, 7).Value = 25 Then
Cells(StartDate_Row, Date_Week_Column_Color).Interior.Color = RGB(204, 255, 299)
End If
If Cells(StartDate_Row, 7).Value = 50 Then
Cells(StartDate_Row, Date_Week_Column_Color).Interior.Color = RGB(153, 255, 204)
End If
If Cells(StartDate_Row, 7).Value = 75 Then
Cells(StartDate_Row, Date_Week_Column_Color).Interior.Color = RGB(102, 255, 178)
End If
If Cells(StartDate_Row, 7).Value = 100 Then
Cells(StartDate_Row, Date_Week_Column_Color).Interior.Color = RGB(50, 200, 100)
End If
If Cells(StartDate_Row, 7).Value = 0 Then
Cells(StartDate_Row, Date_Week_Column_Color).Interior.Color = RGB(149, 179, 215)
End If
Date_Week_Column_Color = Date_Week_Column_Color + 1
Next Number_of_Weeks
End If
Date_Week_Column = Date_Week_Column + 1
Next Total_Weeks
Date_Week_Column = 8
StartDate_Row = StartDate_Row + 1
Loop While (Not IsEmpty(Cells(StartDate_Row, 5)))
End Sub
Tom's suggestion is a possibility but is a lot of bother for the user for every run of your macro.
Possible technique 1
I never refer to columns or rows by numbers for two reasons:
Columns and rows may move as you have discovered.
Someone reading your code must know what column 5 or row 6 means.
It is better to use constants. Fo example:
Const ColXxxx As Long = 5
Const RowYyyy As Long = 8
If Cells(StartDate_Row, ColXxxx).Value = Cells(RowYyyy, Date_Week_Column).Value Then
I do not know what your rows and columns are so I have used ColXxxx and RowYyyy as names. You would replace my names with names that tells the reader what the row and column are.
Code like this takes a little longer to write but (1) it is self documenting and (2) if a column or row moves, you only need to change the Const statement to fix the problem.
Note: I have used data type Long. Data type Integer defines a 16-bit variable which requires special (slow) processing on 32-bit and 64-bit computers.
Possible technique 2
Technique 1 requires the user to tell the programmer that they want to add a column or move a row. If they forget to tell the programmer before runnibg the macro with an amended worksheet, the macro may damage the worksheet beyond repair.
Another technique is to search row 1 for the know column headings and record where there are. Pehaps you have a column heading "Start Date". "Start Date" can be in column 5 for one run of the macro and in column 6 for the next and you code will work just as it should.
If this technique is interesting, I will add example code.
The answer in short is that you must change your code. This becomes a bigger and bigger issue the larger and more complicated your code becomes. Therefore where possible try to think dynamically about the methods you use to specify cell locations.
E.g. You could build into your script a user input which allows the user to specify the column which contains the required information. That way if the user adds more columns to the table, the script will still run correctly (provided the user selects the correct column).
'ask user to select the column containing the data which they would like to utilise
Dim colRng As Range
On Error Resume Next
Set colRng = Application.InputBox("Select a cell from anywhere in the column which contains the programme start dates.", Default:="", Type:=8)
On Error GoTo 0
If colRng Is Nothing Then
'notify user that the process cannot continue as selection was invalid
MsgBox "You must select a cell to enable this process to continue!"
'exit the sub
Exit Sub
End If
'output the column number (as selected by the user)
debug.print colRng.column
Hope that helps!
If you define a named range on your worksheet (using Formulas > Define Name), that name will be updated to point to the same cell(s) even if rows and columns are inserted or deleted.
In your code you can use (for example) MySheet.[MyRangeName].Row to get the row number of the first row of the range named MyRangeName, and so on.
I have a loop wherein I take the mean of several columns of numbers with the same number of rows each.
The point of the loop is to capture these means in a new vector.
So for each loop I need to indicate "all rows". In matlab this would be easy, just use ":" But I can't figure out what the analogy is in VB. Please help! Thanks.
(Please advise me as to what I put in the code below where I have ALLROWS).
My attempt so far:
For i = 1 To CA
mrCA11(i) = Application.WorksheetFunction.Average(revCA11(**ALLROWS**,i))
Next i
In matlab this would be:
For i = 1:CA
mrCA11(i) = mean(revCA11(:,i));
Next i
EDIT: I've also tried this trick to no avail:
For j = 1 To CA
For i = 1 To s11
temp11(i) = revCA11(i, j)
Next i
mrCA11(j) = Application.WorksheetFunction.Average(temp11)
Next j
I get the error message: "Unable to get the Average property of the Worksheet Function class"
As everybody (Tim and shahkalpesh at least) pointed out, we need to understand what is revCall or more specifically, we need to understand how you want to give them ALL ROWS in argument.
Finding the last row (or column or cell)
A common Excel issue is to find the last used row / column / cell.
This will give you the end of your vector.
Excel give you several methods to deal with this:
xlTypeLastCell
Last cell used in the entire sheet (regardless if it's used in column A or not)
lastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
End(xlUp)
Last cell used (including blanks in-between) in Column A is as simple as this:
lastRow = Range("A" & Rows.Count).End(xlUp).Row
End(xlToLeft)
Last cell used (including blanks in-between) in Row 1 is as simple as this:
lastRow = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Row
UsedRange
Last cell used in the WorkSheet (according to Excel interpretation):
Set rangeLastCell = ActiveSheet.UsedRange
Using an array as argument
The methods above told you how to find the last row (if this is what you need). You can then easily create your vector and use it in your procedure revCA11.
You can either give an array as argument as Tim pointed out in his answer with this kind of statement:
myArray = ActiveSheet.Range("A1", Cells(lastRow, lastColumn).Value
Or you can use the integer (or long) to build your vector inside your procedure as simple as declaring a range:
Range("A1:A" & lastRow)
You might clarify exactly how revCA11 is declared/created, but maybe something along these lines might work for you:
Sub Tester()
Dim arr, x
arr = ActiveSheet.Range("A1:D5").Value '2-D array
'average each column
Debug.Print "Columns:"
For x = 1 To UBound(arr, 2)
Debug.Print x, Application.Average(Application.Index(arr, 0, x))
Next x
'average each row
Debug.Print "Rows:"
For x = 1 To UBound(arr, 1)
Debug.Print x, Application.Average(Application.Index(arr, x, 0))
Next x
End Sub