This should be an easy question for the seasoned pros.
1) I'm trying to offset the active cell down one each iteration of the loop.
2) I can only move down by one because I'm not sure of the syntax available.
3) I was thinking the_result = the_result + 1 but that doesn't work :(
Sub vlookupTest()
search = Worksheets("Sheet1").Range("B2")
For i = 2 To 5
the_result = Application.WorksheetFunction.vlookup(search, Worksheets("Sheet1").Range("F2:G5"), 2, True)
MsgBox the_result
search = ActiveCell.Offset(1, 0)
Next i
End Sub
I can see why the loop only moves down two cells and gets stuck since offset only moves down one from "B2" but not sure of the correct syntax to continually move down in this instance
Your code does not explicitly force the ActiveCell to start at Worksheets("Sheet1").Range("B2") but you subsequently offset from the ActiveCell. This seems like a mashup of methods to assign a value into search. It's probably best to avoid relying on ActiveCell altogether.
Sub vlookupTest()
dim searchTerm as variant, the_result as variant
searchTerm = Worksheets("Sheet1").Range("B2").value
For i = 2 To 5
the_result = Application.WorksheetFunction.vlookup(searchTerm , Worksheets("Sheet1").Range("F2:G5"), 2, True)
MsgBox the_result
searchTerm = Worksheets("Sheet1").Range("B2").Offset(i - 1, 0).value
Next i
End Sub
Just as an FYI, the use of True as the range_lookup parameter in VLOOKUP returns an approximate match and F2:F5 must be sorted in an ascending manner.
The ActiveCell never changes in your code.
Replace
search = ActiveCell.Offset(1, 0)
with
ActiveCell.Offset(1, 0).Select
search = ActiveCell
Related
'I need this to repeat the copy and paste process across columns until counter
'= either key page, "book" cell or reads from row 1, if row 1# = key"book"#
'Next column(Page) should be 3columns from last copy/Pasted column
"PicPg" B2 copies to "PrntPg" B2
E2 to E2
etc
**This is my very first post in any forum to ask for help. Forgive the ignorance.
I'll try and answer any questions the best I can.
Thank you in advanced for your time and help!
I can share the workbook, just not sure how.
Sub createPrintPage()
With Worksheets("PicPg").Cells(2, 2)
.Copy
Sheets("PrntPg").Pictures.Paste(Link:=True).Select
With Worksheets("PrntPg").Cells(2, 5)
.Select
Worksheets("PicPg").Cells(2, 5).Copy
Sheets("PrntPg").Pictures.Paste(Link:=True).Select
End With
End With
End Sub
'the "For i", I have not figured out yet. I have been trying to get it to
'continue repeating.... I've tried to play with for i's... I get lost
'this with statement seems to be working, now to get it to continue across.
'this is day 3 ive researched, Tried many ways... and can only get this far (and this
'is much MUCH prettier(ie:Simplier) then where I began.
both method is used to loop and iterate. if you want to use For just give it a beginning and an ending
Dim i As Integer
For i = 0 To 3
'put your code in here and it will loop 4x (i = 0, i = 1, i = 2 and i = 3)
Next i
'you can put your condition for the loop to exit either at the Do or Loop by using until
i = 0
Do Until i = 3
'although start from 0, but it will loop 3x because when it hit i = 3 it will stop (i = 0, i = 1, i = 2 and i = 3)
i = i + 1 'remember to increment your counter, before leaving the loop the counter had changed to 1
Loop
i = 0
Do
'although start from 0, but it will loop 3x because when it hit i = 3 it will stop (i = 0, i = 1, i = 2 and i = 3)
i = i + 1 'remember to increment your counter
Loop Until i = 3
there is also a lot more different ways to write it.
you can use cell iteration to do your loop
Dim cell As Object 'late binding, early binding can write Dim cell as range
For Each cell In ThisWorkbook.Range("A1:A20")
'do something
Next cell
you can even use your own condition to set the stop
Do
If x = 1 Then
ThisWorkbook.Range("A1").Value = "True"
End If
Loop Until ThisWorkbook.Range("A1") = "True"
you can even Exit Do or Exit For if you have already achieved your desired outcome.
Dim i as Integer, temp as string
For i = 0 To 3
If ThisWorkbook.Range("A" & i).Value2 = "True" Then
temp = "hey, I found what I am looking for"
Exit For
End If
Next i
I will admit to being a terrible at code, and have always struggled with Macros... forgive my ignorance.
What I am working on building is a part number index that will create a new sequential number within a numerical series after a macro-button is pressed.
I'd like each button to scan between a range [i.e. 11-0000 (MIN) and 11-9999 (MAX)] and select the max value cell that exists. At that selection point insert an entire new row below with the next + 1 sequential number in the "B" column.
I have my button creating the table row as I would like, however I need help in defining the ".select(=Max(B:B))" and as I understand Max will also limit the # of line items it queries?
I have also been playing with .Range("B" & Rows.CountLarge) with little to no success.
Ideally the 11-**** button [as seen in the screen cap] should insert a sequential number below the highlighted row.
Maybe I'm way over my head, but any guidance even in approach or fundamental structure of the code would help be greatly appreciated!
Private Sub CommandButton1_Click()
Sheets("ENGINEERING-PART NUMBERS").Range("B" & Rows.CountLarge).End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.EntireRow.Insert Shift:=xlDown
ActiveCell.Value = "=ActiveCell + 1"
End Sub
Screen Cap of Spread Sheet
Perhaps there is a simpler solution that I've overlooked, but the below will work.
Insert a module into your workbook and add this code:
Public Sub AddNextPartNumber(ByVal FirstCellInColumn As Range, Optional ByVal PartMask As Variant = "")
Dim Temp As Variant, x As Long, MaxValueFound(1 To 2) As Variant
'Some error checking
If PartMask = "" Then
MsgBox "No part mask supplied", vbCritical
Exit Sub
ElseIf Not PartMask Like "*[#]" Then
MsgBox "Invalid part mask supplied; must end in ""#"".", vbCritical
Exit Sub
ElseIf PartMask Like "*[#]*[!#]*[#]" Then
MsgBox "Invalid part mask supplied; ""#"" must be continuous only.", vbCritical
Exit Sub
End If
'Get the column of data into an array
With FirstCellInColumn.Parent
Temp = .Range(FirstCellInColumn, .Cells(.Rows.Count, FirstCellInColumn.Column).End(xlUp))
End With
'Search through the array and find the largest matching value
For x = 1 To UBound(Temp, 1)
If Temp(x, 1) Like PartMask Then
If MaxValueFound(1) < Temp(x, 1) Then
MaxValueFound(1) = Temp(x, 1)
MaxValueFound(2) = x
End If
End If
Next x
'Output new part number
If MaxValueFound(2) = 0 Then
'This part mask doesn't exist, enter one with 0's at the end of the list
With FirstCellInColumn.Offset(x - 1, 0)
.Value = Replace(PartMask, "#", 0)
.Select
End With
Else
'Get the length of the number to output
Dim NumberMask As String, NumFormatLength As Long
NumFormatLength = Len(PartMask) - Len(Replace(PartMask, "#", ""))
NumberMask = String(NumFormatLength, "#")
'Determine the new part number
MaxValueFound(1) = Replace(MaxValueFound(1), Replace(PartMask, NumberMask, ""), "")
MaxValueFound(1) = Replace(PartMask, NumberMask, "") & Format((MaxValueFound(1) * 1) + 1, String(NumFormatLength, "0"))
'Insert row, add new part number and select new cell
FirstCellInColumn.Offset(MaxValueFound(2), 0).EntireRow.Insert
With FirstCellInColumn.Offset(MaxValueFound(2), 0)
.Value = MaxValueFound(1)
.Select
End With
End If
End Sub
Then, for each button, you write the code like this:
Private Sub CommandButton1_Click()
'this is the code for the [ADD 11-****] button
AddNextPartNumber Me.Range("B16"), "11-####"
End Sub
Private Sub CommandButton2_Click()
'this is the code for the [ADD 22-****] button
AddNextPartNumber Me.Range("B16"), "22-####"
End Sub
This has been written assuming that inserting a new row onto your sheet won't affect other data and that adding new data to the bottom of the table without inserting a row also won't affect other data.
Assuming you're working with a table, by default it should auto-resize to include new data added to the last row.
Good luck learning the ropes. Hopefully my comments help you understand how what I wrote works.
So I am not very good with VBA and how it exactly how everything works but I am sure what I am doing can be condensed I am just not exactly sure how.
Here is the code I am working with:
Sub This()
If ComboBox5.Value = "Test" Then
If Range("R20").Value > 1 Then
Range("D37").Select
ActiveCell.FormulaR1C1 = "=ABS(R[-17]C*(1-R[-17]C[14]))+R[-17]C"
Range("E37").Select
ActiveCell.FormulaR1C1 = "=ABS(R[-17]C*(1-R[-17]C[13]))+R[-17]C"
Range("F37").Select
ActiveCell.FormulaR1C1 = "=ABS(R[-17]C*(1-R[-17]C[12]))+R[-17]C"
Range("G37").Select
ActiveCell.FormulaR1C1 = "=ABS(R[-17]C*(1-R[-17]C[11]))+R[-17]C"
Range("H37").Select
ActiveCell.FormulaR1C1 = "=ABS(R[-17]C*(1-R[-17]C[10]))+R[-17]C"
Range("I37").Select
ActiveCell.FormulaR1C1 = "=ABS(R[-17]C*(1-R[-17]C[9]))+R[-17]C"
Range("J37").Select
ActiveCell.FormulaR1C1 = "=ABS(R[-17]C*(1-R[-17]C[8]))+R[-17]C"
Range("K37").Select
ActiveCell.FormulaR1C1 = "=ABS(R[-17]C*(1-R[-17]C[7]))+R[-17]C"
Range("L37").Select
ActiveCell.FormulaR1C1 = "=ABS(R[-17]C*(1-R[-17]C[6]))+R[-17]C"
Range("M37").Select
ActiveCell.FormulaR1C1 = "=ABS(R[-17]C*(1-R[-17]C[5]))+R[-17]C"
Range("N37").Select
ActiveCell.FormulaR1C1 = "=ABS(R[-17]C*(1-R[-17]C[4]))+R[-17]C"
Range("O37").Select
ActiveCell.FormulaR1C1 = "=ABS(R[-17]C*(1-R[-17]C[3]))+R[-17]C"
Range("P37").Select
ActiveCell.FormulaR1C1 = "=ABS(R[-17]C*(1-R[-17]C[2]))+R[-17]C"
End If
End If
I recorded this Macro, and it works fine, but if I want to do this as well for Range(R23) it is kind of pain. So how would I go about condensing this code. I am sure the formula is not very clear so I want the new updated value of D37 to be:
D37 = (|(R20 - 1)|*D20) + D20
Possibly something like this, though I try not to use R1C1 notation because it is so difficult to read, so I'm not sure this is exactly what you're looking for.
Sub This()
If ComboBox5.Value = "Test" Then
Dim rng as Range, cl as Range, i as Long
If Range("R20").Value > 1 Then
Set rng = Range("D37:P37")
rng.FormulaR1C1 = "=ABS(R[-17]C*(1-R[-17]C18))+R[-17]C"
End If
If Range("R23").Value > 1 Then
'## NOTE: You may need to modify if the Column changes
rng.FormulaR1C1 = "=ABS(R[-17]C*(1-R[-17]C18))+R[-17]C"
Next
End Sub
Explanation of why I use C18 in the formula:
You're original code is using R1C1 notation with relative reference. As you traverse your range of cells (moving from left-to-right) your formula is decrementing the column position, e.g.:
Range("D37").FormulaR1C1 = "=ABS(R[-17]C*(1-R[-17]C[14]))+R[-17]C" '## C[14]
Range("E37").FormulaR1C1 = "=ABS(R[-17]C*(1-R[-17]C[13]))+R[-17]C" '## C[13]
So this means that even though you're changing the offset value in the brackets, you're still refering to the same column, which can be identified in absolute terms using R1C1 notation C18
It appears as though you are placing nearly the same formula in every column in the same row. So, as your title suggests, a for-loop might be appropriate. For instance,
For j = 4 to 100 'or whatever the last column number you want to be
cells(37, j).FormulaR1C1 = "=ABS(R[-17]C*(1-R[-17]C[" & 18 - j & "]))+R[-17]C"
next j
Please be aware that I am working with a series of ~1000 line medical information databases. Due to the size of the databases, manual manipulation of the data is too time consuming. As such, I have attempted to learn VBA and code an Excel 2010 macro using VBA to help me accomplish parsing certain data. The desired output is to split certain characters from a provided string on each line of the database as follows:
99204 - OFFICE/OUTPATIENT VISIT, NEW
will need to be split into
Active Row Active Column = 99204 ActiveRow Active Column+3 = OFFICE/OUTPATIENT VISIT, NEW
I have researched this topic using Walkenbach's "Excel 2013: Power Programming with VBA" and a fair amount of web resources, including this awesome site, but have been unable to develop a fully-workable solution using VBA in Excel. The code for my current macro is:
Sub EasySplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, "-", 2)
For a = 0 To 1
Cells(1, a + 3).Value = Trim(name(a))
Next a
End Sub
The code uses the "-" character as a delimiter to split the input string into two substrings (I have limited the output strings to 2, as there exists in some input strings multiple "-" characters). I have trimmed the second string output to remove leading spaces.
The trouble that I am having is that the output is being presented at the top of the activesheet, instead of on the activerow.
Thank you in advance for any help. I have been working on this for 2 days and although I have made some progress, I feel that I have reached an impasse. I think that the issue is somewhere in the
Cells(1, a + 3).Value = Trim(name(a))
code, specifically with "Cells()".
Thank you Conrad Frix!
Yah.. funny enough. Just after I post I have a brainstorm.. and modify the code to read:
Sub EasySplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, "-", 2)
For a = 0 To 1
ActiveCell.Offset(0, 3 + a).Value = Trim(name(a))
Next a
End Sub
Not quite the colkumn1,column4 output that I want (it outputs to column3,column4), but it will work for my purpose.
Now I need to incorporate a loop so that the code runs on each successive cell in the column (downwards, step 1) skipping all bolded cells, until it hits an empty cell.
Modified answer to modified request.
This will start on row 1 and continue until a blank cell is found in column A. If you would like to start on a different row, perhaps row 2 if you have headers, change the
i = 1
line to
i = 2
I added a check on the upper bound of our variant before doing the output writes, in case the macro is run again on already formatted cells. (Does nothing instead of erroring out)
Sub EasySplit()
Dim initialText As String
Dim i As Double
Dim name As Variant
i = 1
Do While Trim(Cells(i, 1)) <> ""
If Not Cells(i, 1).Font.Bold Then
initialText = Cells(i, 1).text
name = Split(initialText, "-", 2)
If Not UBound(name) < 1 Then
Cells(i, 1) = Trim(name(0))
Cells(i, 4) = Trim(name(1))
End If
End If
i = i + 1
Loop
End Sub
just add a variable to keep track of the active row and then use that in place of the constant 1.
e.g.
Dim iRow as Integer = ActiveCell.Row
For a = 0 To 1
Cells(iRow , a + 3).Value = Trim(name(a))
Next a
Alternate method utilizing TextToColumns. This code also avoids using a loop, making it more efficient and much faster. Comments have been added to assist with understanding the code.
EDIT: I have expanded the code to make it more versatile by using a temp worksheet. You can then output the two columns to wherever you'd like. As stated in your original question, the output is now to columns 1 and 4.
Sub tgr()
Const DataCol As String = "A" 'Change to the correct column letter
Const HeaderRow As Long = 1 'Change to be the correct header row
Dim rngOriginal As Range 'Use this variable to capture your original data
'Capture the original data, starting in Data column and the header row + 1
Set rngOriginal = Range(DataCol & HeaderRow + 1, Cells(Rows.Count, DataCol).End(xlUp))
If rngOriginal.Row < HeaderRow + 1 Then Exit Sub 'No data
'We will be using a temp worksheet, and to avoid a prompt when we delete the temp worksheet we turn off alerts
'We also turn off screenupdating to prevent "screen flickering"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Move the original data to a temp worksheet to perform the split
'To avoid having leading/trailing spaces, replace all instances of " - " with simply "-"
'Lastly, move the split data to desired locations and remove the temp worksheet
With Sheets.Add.Range("A1").Resize(rngOriginal.Rows.Count)
.Value = rngOriginal.Value
.Replace " - ", "-"
.TextToColumns .Cells, xlDelimited, Other:=True, OtherChar:="-"
rngOriginal.Value = .Value
rngOriginal.Offset(, 3).Value = .Offset(, 1).Value
.Worksheet.Delete
End With
'Now that all operations have completed, turn alerts and screenupdating back on
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
You can do this in a single shot without looping using the VBA equivalent of entering this formula, then taking values only
as a formula
=IF(NOT(ISERROR(FIND("-",A1))),RIGHT(A1,LEN(A1)-FIND("-",A1)-1 ),A1)
code
Sub Quicker()
Dim rng1 As Range
Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
With rng1.Offset(0, 3)
.FormulaR1C1 = "=IF(NOT(ISERROR(FIND(""-"",RC[-3]))),RIGHT(RC[-3],LEN(RC[-3])-FIND(""-"",RC[-3])-1 ),RC[-3])"
.Value = .Value
End With
End Sub
I have a problem. I spent hours designing a form which works just great with all your feedback. Today, everything went wrong. The reason for this is simple. A few new columns got added and, obviously, the data my form is reading in is now wrong.
Thus I was thinking of trying the following...
Rather than using the column number as below
TK = Cells(ActiveCell.Row, "S").Value 'everything in the form refers to the active row
I could possibly use the column headings in Row 1.
Is that possible ? This way the spreadsheet can have columns added up to as many as a user would like and the form would dynamically scan for the right heading and get the column number that way.
My thought is, on opening the form, read in all the headings, pick out the ones I need and assign them to a variable. Then I use my normal code and substitute the variable into the column section.
It sounds easy, but I have no idea how to do this.
Use the versatile Find to give you a quick method of detecting where your header is - or if it is missing
Find details here
In the code below I have specified that the search must return
an exact match (xlWhole)
a case sensitive match (False)
The match can be a partial match (xlPart) if you were looking to match say Game out of Game X
code
Const strFind = "Game"
Sub GetEm()
Dim rng1 As Range
Set rng1 = ActiveSheet.Rows(1).Find(strFind, , xlValues, xlWhole, , , False)
If Not rng1 Is Nothing Then
MsgBox "Your column is " & rng1.Column
Else
MsgBox strFind & " not found", vbCritical
End If
End Sub
Why use a loop? There's no need to.
Dim col as variant
Col = application.match("my header", rows(1), 0)
If iserror(col) then
'not found
Else
TK = cells(activecell.row, col)
End if
For this purpose I usually use a function which runs through the headers (in the first row of a sheet) and returns the number of the column which contains the value I have searched for.
Public Function FindColumn(HeaderName As String, Sht As String) As Long
Dim ColFound As Boolean
Dim StartingPoint As Range
ColFound = False
Set StartingPoint = Sheets(Sht).Range("A1")
Do While StartingPoint.Value <> ""
If UCase(Trim(StartingPoint.Value)) = UCase(Trim(HeaderName)) Then
FindColumn = StartingPoint.Column
ColFound = True
Exit Do
Else
Set StartingPoint = StartingPoint.Offset(0, 1)
End If
Loop
If Not ColFound Then FindColumn = 0
End Function
Example:
If the first row of your sheet named "Timeline" contains headers like e.g. "Date" (A1), "Time" (B1), "Value" (C1) then calling FindColumn("Time", "Timeline") returns 2, since "Time" is the second column in sheet "Timeline"
Hope this may help you a little.
Your thought is a good one. Reading in column headers to calculate addresses is one way to avoid hard coding - e.g.
Sub Test()
Dim R As Range
Set R = ActiveSheet.[A1]
Debug.Print ColNo(R, "Col1Hdr")
End Sub
Function ColNo(HdrRange As Range, ColName As String) As Integer
' 1st column with empty header is returned if string not found
ColNo = 1
Do While HdrRange(1, ColNo) <> ""
If HdrRange(1, ColNo) = ColName Then Exit Do
ColNo = ColNo + 1
Loop
End Function
Another way I frequently use - and I must admit I prefer it over the above, is to define Enum's for all my tables in a seperate "definition" module, e.g.
Public Enum T_VPN ' sheet VPN
NofHRows = 3 ' number of header rows
NofCols = 35 ' number of columns
MaxData = 203 ' last row validated
GroupNo = 1
CtyCode = 2
Country = 3
MRegion = 4
PRegion = 5
City = 6
SiteType = 7
' ....
End Enum
and use it like
Sub Test1()
Debug.Print ActiveSheet(T_VPN.NofHRows, T_VPN.Country)
End Sub
As you can see, the usage is simpler. Allthough this is again "some kind" of hardcoding, having all definition in one place reduces maintenance significantly.