I have a macro that inserts 2 columns on my current sheet and pastes information from another sheet.
I want to create 2 variables that are assigned to each column that would change the next time I run the macro to paste the information in the next two columns.
Columns("BO:BO").Select
Selection.Insert Shift:=xlToRight
Range("BO2").Select
ActiveCell.FormulaR1C1 = "Feb weekly-wk 2"
Range("BO19").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(Comparison!RC2,'Jan16 wk4'!R3C15:R34C24,9,FALSE)"
Range("BO19").Select
Selection.AutoFill Destination:=Range("BO19:BO47"), Type:=xlFillDefault
Range("BO19:BO47").Select
Columns("BP:BP").Select
Selection.Insert Shift:=xlToRight
Range("BP2").Select
Selection.Style = "20% - Accent6"
Range("BP2").Select
ActiveCell.FormulaR1C1 = "Diff"
Range("BP19").Select
ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
My idea is to set up a variable that I would replace my current "BO" and "BP" code with.
Dim X as String, Y as String
X = "BO"
y = "BP"
When I run the macro it would change the variable for this example "BO" to "BQ" and "BP" to "BR". Next time I run the macro would change the "BQ" to "BS" and "BR" to "BT".
I just cleaned your code a little:
Dim ColBO As Integer
Dim ColBP As Integer
Dim StrBO As String
Dim StrBP As String
StrBO = "BO"
StrBP = "BP"
ColBO = ActiveWorkbook.Range(StrBO & 1).Column 'instead of StrBO you could directly write ("BO" & 1)
ColBP = ActiveWorkbook.Range(StrBP & 1).Column 'Then you wouldnt need these two variables
Columns(ColBO).Insert Shift:=xlToRight
'Columns(ColBO).Select ' Trying to avoid selection but not sure if this works here...
'Selection.Insert Shift:=xlToRight
Range(1, ColBO).FormulaR1C1 = "Feb weekly-wk 2"
Range(19, ColBO).FormulaR1C1 = "=VLOOKUP(Comparison!RC2,'Jan16 wk4'!R3C15:R34C24,9,FALSE)"
Range(19, ColBO).AutoFill Destination:=Range("BO19:BO47"), Type:=xlFillDefault
Columns(ColBP).Insert Shift:=xlToRight 'Same here as above
Range(2, ColBP).Style = "20% - Accent6"
Range(2, ColBP).FormulaR1C1 = "Diff"
Range(19, ColBP).FormulaR1C1 = "=RC[-2]-RC[-1]"
For the future: If you can, try to avoid .Select/Selection/.Activate if possible. The code can mostly run without such commands and without activating a cell. ;)
If you are not actually writing BO/BP to the range you are transforming I would go with two ints, stored in a hidden sheet. Read/write each time you run the macro.
This is, in my opinion, the easier solution, other places to go would be global variables or storing it to a file.
If you want to use numeric variables you can change approach and use Cells instead of Range:
'You can use the rows below to know the column number
Range("BO1").Activate
ActiveCell.Value = ActiveCell.Column 'This way you get the column number into the cell
ColNum = ActiveCell.Column 'This way you get the column number into the variable
'So now you know that BO column number is 67 and you can use
Cells(1, 67) = "OK"
'Or, using variables:
RowNum = 1
ColNum = 67
Cells(RowNum, ColNum) = "You Got It!"
This makes you able to loop columns simply using a for ... next
If you need to loop from BO to BR you can use
For ColNum = 67 To 70
Cells(1, ColNum) = "OK"
Next ColNum
Hope it helps.
Related
I am looking to autofill the first column (labeled "ID") with sequential numbers starting from 1,2,3,... so on. So far what I have is
Application.DisplayAlerts = True
Dim TradeTable As Excel.ListObject
Set TradeTable = Sheets("Pre Trade").ListObjects("PreTradeTable")
TradeTable.DataBodyRange(1, 1).Select
Selection.Value = 1
TradeTable.DataBodyRange(2, 1).Select
Selection.Value = 2
TradeTable.ListColumns("ID").DataBodyRange.Select
Selection.AutoFill
It does not work. Plus I do not like the non-dynamic reference e.g. (2,1). Is there a way to specify first item in Column Header "ID" and then 2nd cell and then do the autofill?
Set TradeTable = Sheets("Pre Trade").ListObjects("PreTradeTable")
With TradeTable.ListColumns("ID").DataBodyRange
.Cells(1) = 1
.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1
End With
I don't know how to help you with that particular approach but I can suggest another approach.
Set IdCells = TradeTable.ListColumns("ID").DataBodyRange
will give you a range of the cells you need to fill. Then,
For i = 1 to IdCells.count
IdCells(i).value = i
Next i
will populate them, if I remember my syntax correctly.
Hiyall!
This is a followup to previous post. So here is the code which works.
Sub MarcoTemplate()
Dim c As Range
Dim n As String
For Each c In Sheets("ref").Range("A2:A3")
n = c
Vl = Application.WorksheetFunction.VLookup(n, Sheets("ref").Range("A2:D3"), 2, False)
Worksheets.Add.Name = c
ActiveSheet.Move After:=Sheets(ActiveWorkbook.Sheets.Count)
Worksheets("temp").Range("A1:D3").Copy ActiveSheet.Range("A1")
Range("C2").Select
ActiveCell.FormulaR1C1 = "=ref!R2C2" + "+1"
Selection.AutoFill Destination:=Range("C2:C3")
Range("D2").Select
ActiveCell.FormulaR1C1 = "=ref!R2C2" + "*4"
Selection.AutoFill Destination:=Range("D2:D3")
Range("G2").Select
ActiveCell.FormulaR1C1 = Vl
Next c
End Sub
However I'd like to know how do I add formula change within it? I need for each c move formula 1 column or row in any direction in ActiveCell.FormulaR1C1 = "=ref!R2C2" + "+1"
First thing I thought was to add new variable lets say "d" and assing value to it and add +1 in the end like "R2C"&"d" but I dont know how to make d+=1 in the end.
Also another question, how do I change ActiveSheet to the name of newly created list? Sheets("n") does not work.
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
If data_version < 2.11 Then
Range("A10").Select
Selection.Copy
Range("A17").Select
ActiveSheet.Paste
ActiveCell.FormulaR1C1 = "Resume Path Information"
Range("A12:B12").Select
Selection.Copy
Range("A18").Select
ActiveSheet.Paste
ActiveCell.FormulaR1C1 = "Server Path:"
Range("B18") = ""
Dim formula As String
Dim cu_row As Integer
cu_row = 5
Do
'Fix cell to add resume server path
If Len(Trim(Worksheets("People").Cells(cu_row, ResumeFile).Value)) > 0 Then
formula = "=Process!B$18 & """ & Right(Worksheets("People").Cells(cu_row, ResumeFile).Value, Len(Worksheets("People").Cells(cu_row, ResumeFile).Value) - 2) & """"
Worksheets("People").Cells(cu_row, ResumeFile).formula = formula
'Else be sure it is blank
Else
Worksheets("People").Cells(cu_row, ResumeFile).ClearContents
End If
cu_row = cu_row + 1
Loop Until Worksheets("People").Cells(cu_row, 1) = ""
Range("A1").Select
End If
Well, strictly it doesn't do anything because you've got a trailing End If that doesn't match any earlier If. But ...
It looks at successive rows of the worksheet called "People", starting in row 5 and stopping when it finds a row with nothing in the first column. For each row, it looks in the column whose number is in variable ResumeFile. If there's nothing but whitespace there, it clears it completely. Otherwise, it throws away the first two characters, and interpolates the rest into the magic string Process!B$18 & "VALUE_GOES_HERE", which it stores (as a formula) into the same cell. Here, & performs string concatenation.
Finally, it selects cell A1 for some reason.
So, if that column of the worksheet contained "Fred", "Jim" and "Sheila" before, and if cell B18 of the "Process" worksheet contains "Boo!", then you'll get "Boo!ed", "Boo!m" and "Boo!eila".