I created a code that get user inputs and outputs a '2 by n' array from cell X33. n varies. Hence I set the VBA code to select this:
lastCol = Cells(34, Columns.Count).End(xlToLeft).Column
Range(Range("X33"), Cells(34, lastCol)).Select
I am attempting to assign the above selected range into an existing Array2 via Name Manager. When I try record macro via name manager, I am forced to use
With ActiveWorkbook.Names("Array2")
.Name = "Array2"
.RefersToR1C1 = "=Sheet1!R33C24:R34C100"
.Comment = ""
End With
I've attempted by changing C100 above to &lastCol , since the last column in the output can be any number, but the recorded code is fixed and would not assign the array to the selected range I want. Is there any way I may change this code so it would directly take the range selected in the top code instead of a fixed value.
I'm still learning VBA basics as I'm mostly attempting manual edits via recording. Thanks and much appreciated.
dim lastCol as long
lastCol = Cells(34, Columns.Count).End(xlToLeft).Column
With ActiveWorkbook.Names("Array2")
.Name = "Array2"
'written directly
.RefersToR1C1 = "=Sheet1!R33C24:R34C" & lastCol
'or from the selected cells
.RefersToR1C1 = selection.address(1, 1, ReferenceStyle:=xlr1c1, external:=true)
.Comment = ""
End With
Range(Range("X33"), Cells(34, lastCol)).Name = "Array2"
Related
I'm new to VBA but want to automate certain forms in my company.
The code i'm trying to write focusses on entering data in a table based on an Input sheet and then copies on cell a few rows down depending on one variable (amount of cable cores).
The first routine copies the data to the table and then calls upon the second routing to copy the data down. The problem that i'm encountering is that my variables are not updated with the info from the cell, they stay 0.
It's probably an easy fix but i can't seem to solve it. Any help would be much appreciated.
Sub Data_input()
'Inputs the values from input to Overview sheet
next_row = ws1.Range("F" & Rows.Count).End(xlUp).Offset(1).Row
ws1.Cells(next_row, 2).Value = Range("Cable_Number").Value
ws1.Cells(next_row, 3).Value = Range("Equipm_Name").Value
ws1.Cells(next_row, 4).Value = Range("Description").Value
ws1.Cells(next_row, 9).Value = Range("Section").Value
ws1.Cells(next_row, 6).Value = Range("Cable_Number").Value
Application.Run "Module3.Data_Copy"
End Sub
Sub Data_Copy()
Dim b1 As Long
Dim lr As Long
Dim x1 As Long
'set amount of cores in b, b is used to determine amount of copy cycles.
b1 = ws2.Range("Cores").Value
x1 = b1 - 1 'adjusted, because one line is already filled in.
Do Until x1 = 0
'Find the last row with data:
lr = ws1.Cells(Rows.Count, "F").End(xlUp).Row
'Copies the Cablenumber sleeve until all Cores are done:
ws2.Range("Cable_Number").Copy Destination:=ws1.Range("F" & lr + 1)
x1 = x1 - 1
Loop
Application.CutCopyMode = False
End Sub
I managed to solve the problem by adding the explicit tag of the worksheet to each cell value that I want to assign to a variable. Sorry for the initial sloppy question. Friday afternoon and frustrated about not being able to fix the code... Thank you for the input.
I am trying to write a code for filtering data with particular criteria and selecting filtered data, copy and pasting visible cells only in different sheet. However, I am getting error "Run time error 1004" stating MS Office excel can not create or use the data range because it is too complex.
enter image description here
below is the code that I am using
Set mwb = ActiveWorkbook
fname = ActiveWorkbook.Name
pth = path
period = Sheets("DEF").Range("F18").Value
ddate = Range("L6").Value
Sheets("MacroTOSplit").Select
blr = Range("C50").End(xlUp).Row
Rcfield = Range("C1").Value
For a = 4 To blr Step 1
Sheets("MacroTOSplit").Select
If Cells(a, "C").Value <> "" Then
rc1 = Cells(a, "C").Value
Sheets("XYZ").Select
Cells.AutoFilter
If lr >= 2 Then
Range("B2:B" & lr + 1).EntireRow.Delete
End If
Sheets("ABC").Select
dlr = lr
Set datarange = Sheets("ABC").Range(Cells(1, 1), Cells(dlr, "BG"))
'Filter for each unit and copy the data
datarange.AutoFilter Field:=Rcfield, Criteria1:=rc1, Operator:=xlFilterValues
datarange.Range(Cells(2, 1), Cells(dlr, "BG")).SpecialCells(xlCellTypeVisible).Copy Sheets("XYZ").Range("A2")
I am getting error at last step.
Please provide some solution for this.
Thanks,
Ravi
Try adjusting the last line to say:
datarange.Range(Cells(2, 1).address & ":" & Cells(dlr, "BG").address)
I think that you are out of luck if you get the range too complex message.
However, if it is possible, you could pre-sort your data so that the selection is in fewer non-contiguous blocks. This would make the selection less complex.
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.
I have a excel spreadsheet where I have values in a form format, I need to convert them into tabular format. example -
Project ID/Name: 3001 Miscellaneous Improvements
Location: This is Project Location.
Description: This is the project description. This is the project description. This is the project description. This is the project description. This is the project description. This is the project description. This is the project description. This is the project description.
Justification: This is the project Justification. This is the project Justification. This is the project Justification. This is the project Justification. This is the project Justification. This is the project Justification. This is the project Justification.
Duration: Q1 2013 to Ongoing
Status: This is some status
Each block starts with Project ID/Name, however, Description and Justification can vary according to the size of text they have. All the headings are in Column A. If I use Find for ProjectID - and use offset at a fixed length it works but if Justification and description are bigger or smaller they don't fall in correct place. Please help.
You can use TextToColumns. Example:
'Split this cells when find ':" or <TABS>
[A1:A6].TextToColumns Destination:=[A1], DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Tab:=True, OtherChar:=":", _
FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
From what I understand, you want to convert a vertical "form" into a table of data. I suggest adding that data to an existing table.
Here's the code.
You'll need to edit some variables (sheet/range names)
Public Sub test()
'insert your code to get each Worksheet and it's column range here
transferFormDataToTable Range("Sheet1!B1:B100"), Worksheets(2).ListObjects(1)
End Sub
Public Sub transferFormDataToTable(yourRangeB As Range, dbTable As ListObject)
' make a reference to the form data range
Dim formRange As Range
Set formRange = yourRangeB
'create a new ListRow in your target table
Dim listR As ListRow
Set listR = dbTable.ListRows.Add
'transfer the data from form to the new ListRow
Dim lastHeader As String
lastHeader = ""
Dim targetColumnOffset As Integer
targetColumnOffset = 0
Dim currentColumn As Integer
currentColumn = 0
Dim i As Integer
For i = 1 To formRange.Count
'if the row's header is not empty and different than previous row
'then we'll know we have a new column of different type of data
If lastHeader <> formRange(i).Offset(0, -1).Value And formRange(i).Offset(0, -1).Value <> "" Then
lastHeader = formRange(i).Offset(0, -1).Value
targetColumnOffset = 0
currentColumn = currentColumn + 1
End If
'this loop captures data that might have been placed in columns to the right of the input cell
Dim rowString As String
rowString = ""
Dim j As Integer
j = 0
Do While True
If formRange(i).Offset(0, j).Value <> "" Then
If rowString = "" And targetColumnOffset = 0 Then
rowString = formRange(i).Offset(0, j).Value
Else
rowString = rowString & "; " & formRange(i).Offset(0, j).Value
End If
j = j + 1
Else
Exit Do
End If
Loop
If targetColumnOffset = 0 Then
listR.Range(currentColumn).Value = rowString
Else
listR.Range(currentColumn).Value = listR.Range(currentColumn).Value & rowString
End If
targetColumnOffset = targetColumnOffset + 1
'Exit the loop if it seems to get the end
If formRange(i).Value = "" And formRange(i).Offset(0, -1).Value = "" Then _
Exit For
Next i
End Sub
Notes:
Excel has weird bugs occasionally when creating editing with VBA empty tables that have only 1 or 2 rows. I suggest using this macro only when your table has 3+ rows.
Send me a note if you want a much more complete version of this. Namely, a problem you might eventually have with this short version is that the code will screw up if a user switches columns around.
EDIT
I just adapted the code to your requirements. This is bound to get buggy eventually though. I'd really look into convincing the team about just how much they need to find a more appropriate tool. Good luck.
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