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
Related
So my problem is that for previous users who are keeping track of inventory they have labeled items with a ID of example: ABC1234 - ABC1244 but the problem is that when we keep track of our items we need each and ever individual item to be properly accounted for as each item has a unique ID that we track.
So for the past half a year we have been slowly filling in everything and since there are tons of other information in the row that is repeated I was wondering if there was a way to write a VBA macro to expand and insert these rows of data.
So from this
ID
Description
ABC1234 - ABC1237
Screw type A
to this
ID
Description
ABC1234
Screw type A
ABC1235
Screw type A
ABC1236
Screw type A
ABC1237
Screw type A
I have tried using the record macro functions but its not dynamic which is not what I want as the Database can change over time with the influx of new items so I hope there is a way to dynamically complete this process. If anyone knows a solution please help have been banging my head against a wall for awhile now :'D
not sure if this is what you are looking for.
I am assuming your ABC is always the same, the only thing that is changing is the last 4 number.
Sub Formatting()
Dim xlwrks As Object
Dim xlrng As Object
Dim xlcell As Object
Dim lowerlimit As Integer, upperlimit As Integer
Set xlwrks = ThisWorkbook.Sheets("Sheet1")
Set xlrng = xlwrks.Range("A2", xlwrks.Range("A" & Rows.Count).End(xlUp).Address) 'from A2 to last cell in column A
For Each xlcell In xlrng 'iterate ech cell from xlrng
'e.g splitting this into array of string with the delimiter " - " by using split
'which will look something like "ABC1234", "ABC1237" for A2 and "ABC1238", "ABC1242" for A3
'next we only the last 4 number, by using right
lowerlimit = Right(Split(xlcell.Value2, " - ")(0), 4)
upperlimit = Right(Split(xlcell.Value2, " - ")(1), 4)
Do Until lowerlimit = upperlimit + 1
xlwrks.Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Value2 = "ABC" & lowerlimit
xlwrks.Range("D" & Rows.Count).End(xlUp).Offset(0, 1).Value2 = xlcell.Offset(0, 1).Value2
lowerlimit = lowerlimit + 1
Loop
Next xlcell
End Sub
adding on to the requirement, as mentioned, need to monitor the trend. wrote something to check for the trend instead of manually eyeball the trend. Do note with this, the run time will be longer, because it will loop through each cell to look at the array, it will also loop through each array to look at each character. hope this help happy coding!~~
Dim xlwrks As Object
Dim xlrng As Object
Dim xlcell As Object
Dim lowerlimit As Long, upperlimit As Long
Dim charpos As Integer, characters As String, ID As String
Set xlwrks = ThisWorkbook.Sheets("Sheet1")
Set xlrng = xlwrks.Range("A2", xlwrks.Range("A" & Rows.Count).End(xlUp).Address) 'from A2 to last cell in column A
For Each xlcell In xlrng 'iterate ech cell from xlrng
'e.g splitting this into array of string with the delimiter " - " by using split
'which will look something like "ABC1234", "ABC1237" for A2 and "ABC1238", "ABC1242" for A3
'next we only the last 4 number, by using right
characters = Split(xlcell.Value2, " - ")(0)
For charpos = 1 To Len(characters)
If Not IsNumeric(Mid(characters, charpos, 1)) Then
ID = ID & Mid(characters, charpos, 1)
Else
Exit For
End If
Next charpos
For charpos = 1 To Len(characters)
If IsNumeric(Mid(characters, charpos, 1)) Then
lowerlimit = CStr(lowerlimit) & CStr(Mid(characters, charpos, 1))
End If
Next charpos
characters = Split(xlcell.Value2, " - ")(1)
For charpos = 1 To Len(characters)
If IsNumeric(Mid(characters, charpos, 1)) Then
upperlimit = CStr(upperlimit) & CStr(Mid(characters, charpos, 1))
End If
Next charpos
Do Until lowerlimit = upperlimit + 1
xlwrks.Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Value2 = ID & lowerlimit
xlwrks.Range("D" & Rows.Count).End(xlUp).Offset(0, 1).Value2 = xlcell.Offset(0, 1).Value2
lowerlimit = lowerlimit + 1
Loop
lowerlimit = 0
upperlimit = 0
ID = ""
Next xlcell
Honestly, I would not do this with VBA inside the spreadsheet. I would write a separate piece of VB or VBScript that reads the existing spreadsheet and produces a new altered copy of it.
When it reads a line in the original spreadsheet with just "ABC1234", it just copies that line to the new spreadsheet. When it reads a line that contains "ABC1234 - ABC1237", it recognizes the pattern and figures out how many lines it needs to generate in the new spreadsheet. In this case, it will generate four lines: one line for ABC1234, one line for ABC1235, one line for ABC1236, and one line for ABC1237.
I think this approach will be easier to deal with than a VBA script inside the spreadsheet. You will run it once, check the new spreadsheet, then rename the old one for safe-keeping, and rename the new one to give it the original sheet's name.
Been stuck for a while. I hope someone can help me with my current issue, and point me to why I'm having error
Object Required 424 error
Here is the sheet I'm working on, and here is my current code:
note: (me.cmbveh.value is a combo box on my vba form)
Dim v_name As String
Dim add_date As Date
v_name = Me.cmbveh.Value
add_date = Application.WorksheetFunction.VLookup(v_name, Sheets("Vehicle Database").Range("F14:R33"), 13, False)
Application.WorksheetFunction.VLookup(v_name, Sheets("Vehicle Database").Range("F14:R33"), 13, False).Select
ActiveCell.Value = DateSerial(Year(add_date) + 1, Month(add_date), Day(add_date))
The error is pointing in this line of code:
Application.WorksheetFunction.VLookup(v_name, Sheets("Vehicle Database").Range("F14:R33"), 13, False).Select
What I'm trying to do here is, if the value on my combo box has a match on my table, I would like to be able to add 1 year on the "Registration Expiry Date" column.
Any help would be appreciated!
Since you know you are looking to compare your cmbveh Combo-Box value, with the values in Column F, you can use the Application.Match to find the row number that matches the value in the Combo-Box. Afterwards, you can get the row refference (add 13 to it, since your Range starts from row 14 and not row 1), and read the value from Column "R" (where you store your "REGISTRATION EXPIRY DATE").
At last, use the DateAdd function to add 1 year to exisitng date (by choosing "yyyy" as the interval parameter).
Code
Option Explicit
Private Sub CommandButton1_Click()
Dim v_name As String
Dim add_date As Date
Dim MatchRow As Variant
v_name = Me.cmbveh.Value
With Sheets("Vehicle Database")
' first test to see if Match criteria was met (found in Column F)
If Not IsError(Application.Match(v_name, .Range("F14:F33"), 0)) Then
MatchRow = Application.Match(v_name, .Range("F14:F33"), 0) '<-- get row number
.Range("R" & MatchRow + 13).Value = DateAdd("yyyy", 1, .Range("R" & MatchRow + 13).Value)
End If
End With
End Sub
I am working on a spreadsheet one element of which requires a repetitive copy/paste from current column into next column, then copy/paste values back into the first column. The columns in the worksheet contain figures for each working day of the year.
The idea being to keep moving the formula along from yesterday's column into today's column. This is part of a process carried out each morning before starting to input today's data into the worksheet.
Ideally the formula would always be in today's column but the data in yesterday's column should be pasted back in as special values.
I need a macro to streamline the process.
Example:
Copy data range BM53:BM146
Paste into BN53:BN146
Copy data range BM53:BM146
Paste Special Values back into BM53:BM146
Next morning when I run the macro it should then
Copy data range BN53:BN146
Paste into BO53:BO146
Copy data range BN53:BN146
Paste Special Values back into BN53:BN146
And so on each day.
I found the code below through online searches. The code is for rows down the spreadsheet. I tried to rework it for my need which is columns across the spreadsheet but got into a mess.
Code:
Sub AddToNextRow()
Dim Count, LastRow As Integer
LastRow = Cells(35536, 3).End(xlUp).Row
For Count = 3 To 22
ActiveSheet.Cells(LastRow + 1, Count).Formula = ActiveSheet.Cells(LastRow, Count).Formula
ActiveSheet.Cells(LastRow, Count) = ActiveSheet.Cells(LastRow, Count)
Next Count
End Sub
The code you have found is rubbish. I suggest you do not visit the site where you got it again.
"35536" should have been "65536" but only if the code was posted before 2007. Until Excel 2007, the maximum number of rows in a worksheet was 65536. Since then you would be told to write Rows.Count which gives the number of rows per worksheet for the version of Excel being used.
The first task is to find the correct column. You could search from the column for 1-Jan-2015; for a macro that is only run once per day this would be acceptable. However, I have used function DatePart to find an approximate start column and have then searched backwards or forwards for the correct column. This is a bit OTT. I would normally recommend the minimum necessary to achieve the desired effect but I wanted to show you some of the possibilities.
The code you found uses ActiveSheet. This can be appropriate but rarely is. Using ActiveSheet relies on the user have the correct worksheet active when the macro is started. The macro will probably fail to find today’s date in the wrong sheet but it is better if your code explicitly references the correct worksheet.
Row 51 may be the row containing dates today but will it always be the correct row? I have made the row a parameter in a function call for the first block of code. Defining it as a constant is another option:
Const RowDate as Long = 51
I normally find using a constant the best approach for this type of problem. I have a list on constants at the top of my modules for rows, columns and anything else that is currently fixed but might change in the future. Should the value ever change, amending the constant definition is all that is necessary to fully update the macro.
I have set four rows in worksheet “Daily” to list of dates but with different start columns so I could test all the exist points from the function:
TestData
The code below output this to the Immediate Window:
Column in row 51 for today is 63=BK
Column in row 41 for today is 64=BL
Column in row 44 for today is 66=BN
Column in row 47 for today is 60=BH
Option Explicit
Sub TestFindColToday()
Dim ColToday As Long
ColToday = FindColToday("Daily", 51)
Debug.Print "Column in row 51 for today is " & ColToday & "=" & ColNumToCode(ColToday)
ColToday = FindColToday("Daily", 41)
Debug.Print "Column in row 41 for today is " & ColToday & "=" & ColNumToCode(ColToday)
ColToday = FindColToday("Daily", 44)
Debug.Print "Column in row 44 for today is " & ColToday & "=" & ColNumToCode(ColToday)
ColToday = FindColToday("Daily", 47)
Debug.Print "Column in row 47 for today is " & ColToday & "=" & ColNumToCode(ColToday)
End Sub
Function FindColToday(ByVal WshtName As String, RowDate As Long) As Long
Dim ColToday As Long
Dim Today As Date
Today = Date
ColToday = DatePart("y", Today) * 5 / 7
With Worksheets(WshtName)
If .Cells(RowDate, ColToday).Value = Today Then
' Have found Today
FindColToday = ColToday
Exit Function
ElseIf .Cells(RowDate, ColToday).Value > Today Then
' This column is after the column for Today
' Move back until correct column found or does not exist
Do While True
ColToday = ColToday - 1
If .Cells(RowDate, ColToday).Value = Today Then
' Have found Today
FindColToday = ColToday
Exit Function
ElseIf .Cells(RowDate, ColToday).Value < Today Then
' Today is not present in row
Debug.Assert False
' Add appropriate code
End If
Loop
Else
' This column is before the column for Today
' Move forward until correct column found or does not exist
Do While True
ColToday = ColToday + 1
If .Cells(RowDate, ColToday).Value = Today Then
' Have found Today
FindColToday = ColToday
Exit Function
ElseIf .Cells(RowDate, ColToday).Value > Today Then
' Today is not present in row
Debug.Assert False
' Add appropriate code
End If
Loop
End If
End With
End Function
Function ColNumToCode(ByVal ColNum As Long) As String
Dim Code As String
Dim PartNum As Long
' Last updated 3 Feb 12. Adapted to handle three character codes.
If ColNum = 0 Then
ColNumToCode = "0"
Else
Code = ""
Do While ColNum > 0
PartNum = (ColNum - 1) Mod 26
Code = Chr(65 + PartNum) & Code
ColNum = (ColNum - PartNum - 1) \ 26
Loop
End If
ColNumToCode = Code
End Function
I think what you are doing is copying formats, values and formulae forward one column then overwriting the formulae in the yesterday’s columns with their values. If I am wrong, I believe there is enough information for you to adjust the macro to your exactly requirements. Come back with questions as necessary but the more you can do yourself, the faster you will develop.
Sub CopyYesterdayToTodayAndFixYesterday()
' "Yesterday" is the last working day before today. For Tuesday to
' Friday this will be yesterday. For Monday it will Friday. This will
' not be true if columns are omitted for public holidays.
Const RowDate As Long = 51
Const RowCopyFirst As Long = 53
Const RowCopyLast As Long = 146
Const WshtTgtName As String = "Daily"
Dim ColToday As Long
Dim RngSrc As Range
ColToday = FindColToday("Daily", 51)
With Worksheets(WshtTgtName)
Set RngSrc = .Range(.Cells(RowCopyFirst, ColToday - 1), .Cells(RowCopyLast, ColToday - 1))
Debug.Print RngSrc.Address
' Copy yesterday's formats, values and formulae to today
RngSrc.Copy Destination:=.Cells(RowCopyFirst, ColToday)
' Overwrite yesterday's formulae with value
RngSrc.Value = RngSrc.Value
End With
End Sub
It seems you want to copy your formulas from the last used column into a new column then revert the formulas in the original to their values.
with activesheet.cells(53, columns.count).end(xltoleft).resize(94, 1)
.copy destination:=.offset(0, 1)
.value = .value
end with
You should be able to run that daily to generate new columns of formulas to the right. I'm using a set number of rows but those could be adjusted daily as well if it was known what changed them.
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'm relatively new to VBA and I'm trying to write a macro that will compare two columns of data (first and last names). While traversing the column, any time first name = last name (ie. they're both blank or say UNKNOWN) I want the cell in the 9th column to be cleared and the cell in the 10th column to get the value UNKNOWN.
As of now, the code correctly recognizes any time when the first and last name are identical. My problem is that any time first name is a sub-string of any last name (ie. cell I2=David J2=Jones , I3=Joseph J3=Davidson) David gets compared with Davidson and is subsequently erased.
I've spent a while looking for similar problems and I haven't been able to adapt anything to my problem thus far. Thanks in advance for any help.
Sub compare_cols()
Dim Report As Worksheet
Dim i As Integer, j As Integer
Dim lastRow As Integer
Set Report = Excel.ActiveSheet
lastRow = Report.UsedRange.Rows.count
Application.ScreenUpdating = False
For i = 1 To lastRow ' This will find all identical pairs of cells in I,J (blank, blank) or (unknown, unknown). I stays blank, J gets UNKNOWN
For j = 1 To lastRow ' I think its currently erasing any matches (ex. if someones first name is James, it will get erased if there is a last name jameson)
If InStr(1, Report.Cells(j, 10).Value, Report.Cells(i, 9).Value, vbTextCompare) > 0 Then
Report.Cells(i, 9).Value = ""
Report.Cells(i, 10).Value = "UNKNOWN"
Exit For
Else
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
Unlike some other languages, you can compare strings in vba just using the "=" sign and that will find exact matches, which is what it appears you are looking for. Try
if Report.Cells(j, 10) = Report.Cells(i, 9) etc.