I am trying to store ranges in range variables startID, endID, and endDest, but I keep getting runtime error 1004 "Method Range of object _Global failed."
I have a list of loans on the Control Page of my workbook, and they all have multiple lines (anywhere from 2 to 6 lines) like this:
A | B | C
loan 1 | stuff | 1.0
loan 1 | stuff | 1.1
loan 2 | stuff | 2.0
loan 2 | stuff | 2.1
loan 2 | stuff | 2.2
The whole purpose is to move the loan where the activecell is down to the bottom of the list. Here's what I'm having trouble with (so far): Say the activecell is B2 in the little bulleted list makeshift worksheet above--the row of the activecell along with a fixed column index of 3 indicates that I'm on line 1.1. I then "fix" 1.1 to 1 and store that integer in currentID. Now I can Find the first occurrence of currentID in Column C, then store the address of the range where currentID appears in the range variable startID. In this case, I should be storing C1 in startID.
I have read that Find returns a range. So I tried Set startID = .Range("C:C").Find(what:=currentID), but that just stores the currentID of 1 in startID. So then I tried Set startID = Range(.Range("C:C").Find(what:=currentID)) (which is what appears below in my code block), but that causes the runtime error. I have also tried adding and removing periods in case I was messing up the With statement, but that didn't help. Any thoughts?
If there is some obvious thing I'm missing, I apologize. I have been using VBA for about three weeks now, so I typically have to google every single thing I need until I start remembering recurring themes.
Sub ExpireLoan()
With Workbooks("1908 AUS IC Loans Recon.xlsm").Worksheets("Control Page")
Dim currentID As Integer
Dim startID As Range
Dim endID As Range
Dim endDest As Range
Dim rowCount As Integer
'find the current loan range
currentID = Fix(.Cells(ActiveCell.Row, 3).Value)
Set startID = Range(.Range("C:C").Find(what:=currentID))
Set endID = Range(.Range("C:C").Find(what:=currentID + 1))
Set endID = Range(endID.Offset(-1, 0))
'find the last row
Set endDest = .Range("A7").End(xlDown)
Set endDest = endDest.Offset(-1, 0)
'copy the current loan and paste into the end of the table
rowCount = .Range(startID, endID).Count
.Range(startID, endID).EntireRow.Copy
.endDest.EntireRow.PasteSpecial
'set bottom border at new end of the table
endDest.Select
ActiveCell.Offset(0, 0).Range("A1:AF1").Borders(xlEdgeBottom).LineStyle = xlDouble
'delete rows from loan's original position above
.Range(startID, endID).EntireRow.Delete
'set sort ID
ActiveCell.Offset(0, 2).Value = Fix(ActiveCell.Offset(-1, 2).Value) + 1
For i = 0 To rowCount - 2
ActiveCell.Offset(i + 1, 2).Value = ActiveCell.Offset(i, 2).Value + 0.1
Next
'delete loanTypeCode
ActiveCell.Offset(0, 1).ClearContents
For i = 1 To rowCount - 1
ActiveCell.Offset(i, 1).ClearContents
Next
'fix sortID
Set sortIdRange = Range(startID, startID.End(xlDown))
Call subtractOneFromCells
'make it red
ActiveCell.Offset(0, 0).Range("A1:AF1").Interior.TintAndShade = 0.399975585192419
For i = 1 To rowCount - 1
ActiveCell.Offset(i, 17).Range("A1:P1").Interior.TintAndShade = 0.399975585192419
Next
End With
End Sub
In my experience .Find can act a little weird when looking for numbers. Using xlWhole usually fixes it for me and it also did when I tried it on your sample data. Otherwise, if you're looking for the currentID = 3 for example, .Find would return the fist cell that has a 3 in it as a sub-string. That means a cell with the value 1.3 could be returned as the first occurrence of 3. Try this line:
Set startID = .Range("C:C").Find(What:=currentID, LookAt:=xlWhole)
To debug this you might use F8 to step through the code line by line and use Debug.Print currentID and Debug.Print startID.Address to see what is happening through the immediate window.
A tip for shorter code (not necessesarily always more readable) is the following: You can consolidate two lines like these:
Set endDest = .Range("A7").End(xlDown)
Set endDest = endDest.Offset(-1, 0)
into one line like this:
Set endDest = .Range("A7").End(xlDown).Offset(-1, 0)
Since your first line returns a Range object there is no need to store it in a variable inbetween steps.
On another note, regarding these two lines:
endDest.Select
ActiveCell.Offset(0, 0).Range("A1:AF1").Borders(xlEdgeBottom).LineStyle = xlDouble
First of all it is recommended to avoid using .Select whenever possible as it is described here: How to avoid using Select in Excel VBA. Secondly, that second line is hard to understand. Try using Resize like this instead:
ActiveCell.Resize(1, 32).Borders(xlEdgeBottom).LineStyle = xlDouble
Related
I would briefly like to start off with I have never touched VBA let alone excel macros until a couple days ago.
I need to transfer and convert data of 1000 rows (4 columns) from one sheet (Sheet 1) to another (Sheet 2).
A quick description of what I'm given, each row is an object, I have 4 columns.
The first one (column) is the Object ID, the second one is the Object name, the third one explain the what of the object and the final column explains the how. This is a very simplified version as explaining the entire project would be complicated.
On the second sheet, I have 6000 rows all with the object's IDs and Names however the What and How are missing.
My goal is to take the what and how of an object from this sheet, convert the wording to a form in which the second sheet accepts and make sure it gets added to the proper ID.
I have tried multiple code samples I have found online to try and select and organize into tables (arrays) the information from the first sheet, I failed miserably.
Converting the What and How
The second sheet has a very strict format in which everything can be written. In my mind (Lua is my main language), I would have a dictionary or table with all possible ways of the How/What could be written on the first sheet and checking each one to see if they match then change it to the corresponding sheet 2 format. Let me show you. (This is the what. There'd be another table for the how which I'll show below)
local MType = {
["Industrial"] = {"MILPRO : Industrial","Industrial"};
["Public Saftey"] = {"MILPRO : Public Saftey", "Public Saftey"};
["Military"] = {"MILPRO : Military","Military"};
["Paddling"] = {"Recreation : Paddling","Paddling"};
["Sporting Goods"] = {"Recreation : Sporting Goods","Sporting Goods"};
["Outdoor"] = {"Recreation : Outdoor", "Outdoor"};
["Hook & Bullet"] = {"Recreation : Hook & Bullet", "Hook & Bullet"};
["Marine"] = {"Recreation : Marine","Marine","Marina / Lodge"};
["Sailing"] = {"Recreation : Sailing","Sailing"};
["Unknown"] = {"UNKNOWN"}
}
local CType = {
["Multi-Door"] = {"Multi-Door","Multi-door"};
["Dealer & Distributor"] = {"Distributor","Dealer & Distributor"};
["Independant Specialty"] = {"Independant Specialty","Specialty"};
["OEM"] = {"OEM","OEM - VAR"};
["Internal"] = {"Internal","Sales Agency","Repairs Facility"};
["Rental"] = {"Rental / Outfitter", "Rental"};
["End User"] = {"End User"};
["Institution"] = {"Institution","Government Direct"};
["Unknown"] = {"UNKNOWN"}
}
The first position in each table (table = the curly brackets) is the format in which the second sheet accepts. The rest in the tables is how they might be written in the first sheet. (This is how I imagine this would go down. Idk the functions and limits of VBA)
Matching the Information to the Proper IDs
Every object has an ID 6 characters long ranging from 000100 to 999999. When taking information from the first sheet, I need to make sure it gets placed back in the row with the right ID in the second sheet (Note there's 1000 rows on the first sheet and 6000 on the second sheet).
Final notes: The IDs are stored as text and not numbers (If they need to change lmk). Both sheet's information are within tables. I'll probably be using this method for other similar sheet 1s. Any conversions (for the what and how) that fail should be marked down as Unknown.
A Visual Representation of the 2 Sheets
Sheet 1 Format
Sheet 2 format
We can create a 2 dimensional array to hold all the pairs of one dictionary, then check against each element using a For..Next loop.
Sub transcribe()
On Error GoTo Handler
Application.ScreenUpdating = False
Dim WS1 As Worksheet, WS2 As Worksheet
Dim ID1 As Range, ID2 As Range
'This is assuming youre working in Sheets 1 and 2
Set WS1 = Sheets(1)
Set WS2 = Sheets(2)
'This is assuming your tables are in these locations
Set ID1 = WS1.Range(WS1.Cells(1, 1), WS1.Cells(10, 1))
Set ID2 = WS2.Range(WS2.Cells(1, 1), WS2.Cells(20, 1))
Dim cellx As Range
Dim rowID1 As Integer
Dim FieldA As String, FieldB As String
Dim IDfound As Boolean
IDfound = True
Dim arrayA(1 To 10, 1) As String
arrayA(1, 0) = "MILPRO : Industrial"
arrayA(1, 1) = "Industrial"
arrayA(2, 0) = "MILPRO : Public Saftey"
arrayA(2, 1) = "Public Saftey"
'... etc. You have to complete this array with all the pairs of your dictionary of Field A
'array(X, 1) holds what you expect to find in table 1, and array(X, 0) holds what you want to write down in table 2.
Dim arrayB(1 To 9, 1) As String
arrayB(1, 0) = "Multi-Door"
arrayB(1, 1) = "Multi-Door"
arrayB(2, 0) = "Distribuitor"
arrayB(2, 1) = "Dealer & Distribuitor"
'... etc. You have to complete this array with all the pairs of your dictionary of Field B
'array(X, 1) holds what you expect to find in table 1, and array(X, 0) holds what you want to write down in table 2.
'Now we sweep each cell in Table 2
For Each cellx In ID2.Cells
'And we search its ID for a match in Table 1.
rowID1 = Application.Match(cellx.Value, ID1, 0)
If IDfound = True Then
'We then write down the values of Field A and B in the found row
FieldA = ID1.Resize(1).Offset(rowID1 - 1, 2).Value
FieldB = ID1.Resize(1).Offset(rowID1 - 1, 3).Value
'And we call a function (see below) to correct their values
cellx.Offset(0, 2).Value = corrected(FieldA, arrayA, 10)
cellx.Offset(0, 3).Value = corrected(FieldB, arrayB, 9)
Else
cellx.Offset(0, 2).Value = "ID not found"
cellx.Offset(0, 3).Value = "ID not found"
IDfound = True
End If
Next
Application.ScreenUpdating = True
Exit Sub
Handler:
IDfound = False
Resume Next
End Sub
Function corrected(Field As String, arrayX As Variant, UB As Integer) As String
'This is the dictionary-like function
Dim found As Boolean
'We sweep each element in the dictionary array until we find a match
For i = 1 To UB
If Field = arrayX(i, 1) Then
corrected = arrayX(i, 0)
found = True
Exit Function
Exit For
End If
Next
'If no match was found, we will write that down in the result
If found = False Then
corrected = Field & " - Not found in dictionary"
Exit Function
End If
'This code should never be reached, its just for foolproofing
corrected = "Error"
End Function
I am working with a VB macro. Essentially what I am trying to do is for the macros to read the input and first determine whether or not a cells ID number matches the one in the row. Example: If row 1 has an ID of 1122 and rows 2,3,4 and 5 all match, I want the macro to read that and create a count in the NbrOfA cell. Once it realizes that there is not an ID match it moves on to the next ID and looks for matches of that ID number and continues to create a count. While it is doing this, I also need it to read from another column that has specific strings such as "open", "closed" ect. read that input, and create a separate row titled NbrofOpenA. Once it runs out of data, I then want to have a singular cell that shows the number of actions (NbrOfA) that match the ID number as well as the number of open actions (NbrOfOpenA).
Currently I receive the error: “compile error: sub or function not defined” highlighting the Set Cell(Sheet2.Cells(FirstRowOfI, 23) = NbrOfA
Attached in the excel sheet attached it shows 2 cells deleted. They will not actually be deleted, just wanted to give an idea of what I was looking for
Sub ACount()
Dim FirstRowofI
Dim NbrOfA as Integer
Dim NbrOfOpenA as Integer
Row = 2
Set FirstRowofI = (Sheet2.Cells.Range(Row, 14))
NbrOfA = 0
NbrOfOpenA = 0
If (Sheet2.Cells(Row, 14).Value <> "") Then
NbrOfA = 1
If (Sheet2.Cells(Row, 22) <> "Closed") Then
NbrOfOpenA = 1
Set Row = FirstRowofI
Row = Row + 1
Do While (Sheet2.Cells(Row, 14) = (Sheet2.Cells(FirstRowofI, 14)))
NbrOfOpenA = NbrOfOpenA + 1
If (Sheet2.Cells(Row, 22) <> "Closed" Then
NbrOfOpenA = NbrOfOpenA + 1
Range(Row).EntireRow.Delete
Return
End If
Set Cell(Sheet2.Cells(FirstRowofI, 23)) = NbrOfA
Set Cell(Sheet2.Cells(FirstRowofI, 24)) = NbrOfOpenA
Loop
End Sub
[1
Do you need VBA? You can easily achieve what you're looking for with formulas, heck even a Pivot Table! Here's an example with formulas:
I need to copy date and time, code and names from a big data sheet, which contains multiple columns. Row counts may differ.
The sequence of actions should be:
Copy the consecutive Range from A3 which is the first active cell through to the data at column AZ - This is a manual selection.
Using the VBA linked Command button start the process of copying data in next sheet:
for example
sheet1.column B = sheet2.column A
sheet2.column B= ""
'empty and data copy is not needed, please just generate the empty row
sheet1.column Y = sheet2.column C
After the copying process is over, clear all data from sheet1
My core problem is the data count for above rows differs every time. I can't find a correct sequence of commands to get these columns in the order I need from sheet1. To add to that, the formatting breaks and the time values are 'stringified', so it can't be reused.
The generated data needs to be exported to another workbook and the copying process is critically important as I do it repeatedly. Locating and copying each column manually every time.
The solution to your problem is of the form f(x) = y where x is the column no. of the source sheet and y is the column number of that very same column on the destination sheet.
f(x) is a simple mapping between a Source column and transformed into a destination column no.
As you still need to define the problem better by including sample data, I'll simply brief you on The 3 steps to resolve your problem.
I hope you know your VBA well enough to encode the steps into the specific VBA code you need to solve this permanently.
Create a sheet as a "ControlPanel" that maps the columns you need.
Assuming your sheets are named appropriately as per the code below.
Kindly do apply your VBA skills and discretion to customize the code below as per your needs.
Public Sub Add_Msng_And_Check_Prev_EmpData()
'' Objective : Check missing employees from the incoming data placed in the Destination_Sheet sheet which is the client's format.
'' The _Source_Sheet sheet is our destination where processed data sits,
'' columns from Destination_Sheet are mapped to specific columns of the _Source_Sheet sheet.
'' Copy the missing emp codes to these mapped columns.
'' Support : myfullnamewithoutspaces#gmail.com
'' Status : Production 14-Dec-2016 10.32 PM
'' Version : 1.0
'' To Do : 10 is the column number on Source_Sheet where the emp code resides
'' Convert this magic number to a generic solution
Dim Src_Sheet, Destination_Sheet As Worksheet
Dim Dest_Sheet_Column_Mapping, Src_Sheet_Column_Location As Range
Set Src_Sheet = Sheets("Source_Sheet")
Set Destination_Sheet = Sheets("Destination_Sheet")
Set Dest_Sheet_Column_Mapping = Sheets("ControlPanel").Range("A2:A60")
Set Src_Sheet_Column_Location = Sheets("ControlPanel").Range("D2:D60")
Dim myMap() As Integer
Dim myRow As Variant
ReDim myMap(Dest_Sheet_Column_Mapping.Count + 1)
'' Map the source_columns to the destination_columns
For Each myRow In Src_Sheet_Column_Location
'' Index corresponds to Source_Sheet column
'' Value at Index to Destination_Sheet
'' for eg: Destination_Sheet.column = myMap(Src_Sheet.column)
myMap(myRow) = Dest_Sheet_Column_Mapping.Cells(myRow, 1).Value
Next myRow
Dim Primary_Key_Not_Null As Collection
Set Primary_Key_Not_Null = New Collection
Dim Master, Src_Sheet_Range, Src_Range As Range
Dim MissingEmployeeCode, LookupValue, tempVar, LookupResult As Variant
Dim LastRow, i, Src_Range_Rows_Count, Src_Sheet_Range_Rows_Count As Integer
'' This is the source of all new entries we need to search for.
Set Src_Sheet_Range = Destination_Sheet.Range(Destination_Sheet.Cells(1, myMap(10)), Destination_Sheet.Cells(Destination_Sheet.Cells(1048576, myMap(10)).End(xlUp).Row, myMap(10)))
Src_Sheet_Range_Rows_Count = Src_Sheet_Range.Rows.Count
'' This is the database of all previous existing entries we need to search against.
Set Src_Range = Src_Sheet.Range(Src_Sheet.Cells(1, 10), Src_Sheet.Cells(Src_Sheet.Cells(1048576, 10).End(xlUp).Row, 10))
Src_Range_Rows_Count = Src_Range.Rows.Count
For i = 3 To Src_Sheet_Range_Rows_Count
'' Skip the blank rows and header at rows 0 to 2
On Error Resume Next
LookupValue = Destination_Sheet.Cells(i, myMap(10)).Value
LookupResult = Application.Match(LookupValue, Src_Range, 0)
If (IsError(LookupResult)) Then
'' To Do : Check for Duplicates within the previously added values
'' LookupValue becomes your missing empcode and i is the row number it's located at
'' The row number i becomes critical when you want to copy the same record that you have just found missing.
Primary_Key_Not_Null.Add i '' LookupValue
'' LookupValue is the actual missing empcode, however we need the row number for the copy operation later
End If
Next i
LastRow = Src_Sheet.Cells(1048576, 10).End(xlUp).Offset(1, 0).Row
Dim FirstRow, LastColumn, j, Src_Range_Columns_Count As Integer
FirstRow = LastRow
''--Phase 3--------------------------------------------------------------------------------------------------
'' Objective : Get and paste data for each missing empcode
With Src_Range
LastColumn = .Cells(1, 1).End(xlToRight).Column
LastRow = Primary_Key_Not_Null.Count + FirstRow
Set Src_Range = .Range(.Cells(1, 1), .Cells(LastRow, LastColumn))
Src_Range_Columns_Count = Src_Range.Columns.Count
For i = FirstRow To LastRow ''FirstRow + 3 '' Commented for Debugging
For j = 1 To Src_Range_Columns_Count '' 59
'' The simple logic is Row Numbers and Column numbers obtained from all the above operations
'' define the cells in the Src_Sheet sheet that we need this data pasted ito.
'' For details please see the code below.
Src_Sheet.Cells(i, j).Value = Destination_Sheet.Cells(Primary_Key_Not_Null(i - FirstRow + 1), myMap(j)).Value
Next j
Next i
End With
''--Phase 4--------------------------------------------------------------------------------------------------
'' Objective : For the previous range in Source_Sheet, check each cell in each column against the mapped columns in the Destination_Sheet.
'' When you find a discrepancy: style it Bad, for the matches: style it Good,
'' for the not found : Style it neutral.
LastRow = FirstRow
FirstRow = 2
Set Src_Range = Src_Sheet.Range(Src_Sheet.Cells(2, 1), Src_Sheet.Cells(LastRow, LastColumn))
Src_Range.Style = "Normal"
Dim FoundRow, FoundColumn As Integer
FoundRow = 0
FoundColumn = 10
Dim LookupRange, LookupDatabase As Range
Set LookupRange = Src_Sheet.Range(Src_Sheet.Cells(1, 10), Src_Sheet.Cells(LastRow, 10))
Set LookupDatabase = Destination_Sheet.Range(Destination_Sheet.Cells(1, myMap(10)), Destination_Sheet.Cells(Src_Sheet_Range_Rows_Count, myMap(10)))
Dim FoundRows As Collection
Set FoundRows = New Collection
'' Locate the row of each employee code on Emp Master, push it into a collection and let the emp code be it's key
Dim LookupRange_Row_Count As Integer
LookupRange_Row_Count = LookupRange.Rows.Count
For i = 2 To LookupRange_Row_Count
On Error Resume Next
FoundRow = Application.Match(LookupRange.Cells(i, 1).Value, LookupDatabase, 0)
If (Not IsError(FoundRow)) Then
'' myRow contains EmpCode which is the key, FoundRow = Where I Found it, becomes the value.
FoundRows.Add FoundRow, CStr(LookupRange.Cells(i, 1).Value)
End If
Next i
Dim Src_Sheet_Value, EmpMstrValue, myEmpCodeString As String
For i = FirstRow To LastRow '' 2 to 1029
For j = 1 To Src_Range_Columns_Count '' 59
'' Handle 4 cases.
'' 1. Src_Sheet Cell Value Found and matches = Good
'' 2. Src_Sheet Cell Value Found and does not match = Bad
'' 3. Src_Sheet Cell Value Not Found or not in Scope and hence does not match = Neutral
'' 4. Src_Sheet Cell Value is a duplicate of a value which is already checked earlier. = ??
Src_Sheet_Value = Src_Sheet.Cells(i, j).Value
myEmpCodeString = CStr(LookupRange.Cells(i, 1).Value)
myRow = CInt(FoundRows(myEmpCodeString))
EmpMstrValue = Destination_Sheet.Cells(myRow, myMap(j)).Value
'' Implements 1. Src_Sheet Cell Value Found and matches = Good
If Src_Sheet_Value = EmpMstrValue Then
Src_Sheet.Cells(i, j).Style = "Good"
Else
Src_Sheet.Cells(i, j).Style = "Bad"
End If
Next j
Next i
End Sub
I found myself in the same situation as yourself sometime back. Although the code is conceptually simple, it requires you to thoroughly define your problem in the Source, Destination, Transformation pattern.
Do Feel free to mail me at myfullnamewithoutspaces#gmail.com. I'll assist any way I can.
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 need to hide a range of cells using a macro in excel. C11 contains the column index from where I need to start hiding the columns.
Sub test()
Dim i As Integer
Dim j As Integer
Dim rocket As Range
i = Range("c11").Value
j = 12
rocket = Range(Cells(5, i), Cells(5, j))
Range("Rocket").Select
Selection.EntireColumn.Hidden = True
End Sub
The code is giving some unexpected error and as I am a novice, so have no clue what needs to be done..
Tree steps to make your code working:
1st. Add Set key word in appropriate line which is necessary:
Set rocket = Range(Cells(5, i), Cells(5, j))
2nd. Rocket variable represents range, you will NOT need to call it in this way:
Range("Rocket")....
but
rocket....
3rd. Avoid Select method and Selection object always when possible. Therefore the last two lines replace with this single one (which implements 2nd step, too):
rocket.EntireColumn.Hidden = true
That last answer was awesome! Just for someone else's FYI, here is what worked in Excel 2007. The first line is always 3, but the ending line needed to be a variable. That's where I had the problem. THIS FIXED IT! The last 4 lines before the "End If" do the work. Hope this helps!
Dim RowsToHide As Range
Dim RowHideNum As Integer
' Set Correct Start Dates for Billing in New File
Workbooks("----- Combined_New_Students_Updated.xlsx").Activate
Sheets("2015").Activate
StartDateLine1 = Format(START_DATE_1, "ww") - 1 ' Convert Start Date to Week Number
StartDateLine1 = (StartDateLine1 * 6) - 2 ' Convert Start Date to Line Number
If StartDateLine1 >= "10" Then
Cells(4, "q").Value = ""
Cells(StartDateLine1, "q").Value = STATUS_1
Cells(StartDateLine1, "z").Value = "START DATE " + START_DATE_1
RowHideNum = StartDateLine1 - 2
Set RowsToHide = Range(Cells(3, "a"), Cells(RowHideNum, "ab"))
RowsToHide.Select
RowsToHide.EntireRow.Hidden = True
End If