I am trying to select a specific range of data and delete only the cells I identify, not the entire row.
I have included the coding that I currently have. I am trying to select everything to the left of the indicated cell, delete the range, and shift all cells up. I cannot input a specific range (ie. Range("B3:B7").delete, etc.) as the range will be changing throughout the code. I need it to be a dynamic range that will change as the code runs.
Worksheets("Sheet1").Select
Cells(2, 6).Select
ActiveCell.Offset(0, 1).Select
col = ActiveCell.Column
row = ActiveCell.Row
Cells(row, col).Select
Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
Range.Delete Shift:=xlToUp
Let me know if you need any more information. Code will run up until I hit the last line (Range.Delete).
Thanks in advance.
I think this is what you are looking for. When you select any single cell, this line of code will select the range from column A and the active row, to the active column + 1 on the active row.
ThisWorkbook.Sheets("Sheet1").Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, ActiveCell.Column + 1)).Delete
I can't write it for you. But consider this technique since you seem to be doing this manually. Application.Inputbox is a built in userform that pauses the code execution until you review the range / craft your own selection.
Dim xrng As Range
Dim rngholder As Range
Dim xArray(0 To 20) As Variant
Dim x As Integer
Set xrng = Application.Selection
Set xrng = Application.InputBox("Title", "Make a selection", xrng.Address, Type:=8)
x = 0
'If xrng = "" Then Exit Sub
For Each rngholder In ActiveSheet.Range(xrng.Address)
If rngholder.Value > "" Then
xArray(x) = VBA.Trim(rngholder.Value)
Else
End If
x = x + 1
Next rngholder
In this case the Inputbox is loaded with the active cell or whatever the selection was when the macro was called and the range is populated into an array. Where you can customize this is on the line set 'xrng =' line. I would put 'set xrng = the logic to get that selection you've described so everything to the left, and up, and delete it.
edit:
Set xrng = Range(ActiveCell, Range(ActiveCell.End(xlToLeft), ActiveCell.End(xlUp))).Select
You can figure this out with a little more research into ranges. If you chose this answer you'll have an interface to handle exceptions manually, and since it seems to me you're doing this somewhat by eye, its a compromise you might benefit from in actual use.
Related
I have made a simple macro assigned to a hotkey to select the current region and then remove the header row. The problem is that the ranges we work with are often full of blank cells which prevent the selector from capturing the entire table dependant on the activecell.
I thought about maybe simply creating a loop, offsetting the ActiveCell and trying again until it hits an illegal range, but I have a bad feeling about this approach.
Sub multieditSelect()
Dim tbl As Range
If ActiveCell.Value = "" Then
MsgBox "Select a cell with something in it, you bastard"
Exit Sub
End If
Call startNoUpdates
Set tbl = ActiveCell.CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _
tbl.Columns.Count).Select
Call endNoUpdates
Selection.Copy
End Sub
Is there a way to make this more reliable?
Edit: Let me add further complication/detail to this problem...
We work with a database and editing records en masse requires exporting them into excel, and the copy/pasting them back into the web interface, so it is common for us to be working with numerous tables of different size, using a worksheet like a notepad to store and modify them.
I want to create a sub that will select the current region irrespective of where it lies on the worksheet, quite possibly this is the third or fourth table to have been pasted onto the same sheet.
This makes going by the last column or last row too inflexible. CurrentRegion is ideal were it not for it's occasional failure to detect the table... so I suppose I need to build my own version of CurrentRegion that will overcome it's shortcomings.
Edit2: I've come up with a lazy solution.
Since these tables will always have a header, I'll just have the activecell offset up till it hits something, and hopefully that will be the header if an empty column is the starting point.
I think this will still be unreliable should there be a pocket of cells surrounded by empty cells in the middle of the table.
Sub multieditSelect2()
Dim tbl As Range
On Error GoTo errmsg
startNoUpdates
Do While ActiveCell.Value = ""
ActiveCell.Offset(-1, 0).Activate
Loop
startNoUpdates
Set tbl = ActiveCell.CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _
tbl.Columns.Count).Select
endNoUpdates
Selection.Copy
Exit Sub
errmsg:
endNoUpdates
errMsgBox = MsgBox("Couldn't find a table!", vbCritical, "Error!")
End Sub
Edit3: Here is an example of where my code calls down:
I would like it to be able to capture the table even in this scenario where a cell in the test region is the activecell... but how?
Additional to my comment, see if this helps improve your logic (see comments in code for more details):
Sub multieditSelect()
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Sheet1") 'use a variable for the sheet you want to use
Dim tbl As Range
Dim lRow As Long, lCol As Long
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row 'last row at column 1
lCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column 'last column at row 1
Set tbl = ws.Range(ws.Cells(2, l), ws.Cells(lRow, lCol)) 'Set the range starting at row 2, column 1, until last row, last col
Call endNoUpdates(tbl) 'pass your range as a parameter if you require this specific range in your other sub
tbl.Copy Destination:=tbl.Offset(0, 20) 'copy 20 columns to the right
'Alternative
ws.Range("W1").Resize(tbl.Rows.Count, tbl.Columns.Count).Value = tbl.Value 'copy values to specific range
End Sub
Sub endNoUpdates(tbl As Range)
'do something with this range, i.e.:
Debug.Print tbl.address
End Sub
In the screenshot you can see some part of my table.
In columns A:D I put in some Value, the Value in Column B is searched in Row 1 and the Value from C:D is search in Row 2. After that it colors the cells red which are in the founded range.
The Examples "Test" and "Test2" works fine. But the 3. and 4. example does not work with my code, because the given numbers are not in Range("E2:AM2").
My question now, is how can i find the Start- and Endtemp if there are numbers like 5,15,25,152,87, ...
Here is my Code so far:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim a As Long
Dim turnCol As Range
Set ws = ThisWorkbook.Worksheets(1)
With ws
If Not Application.Intersect(Range("D:D"), Range(Target.Address)) Is Nothing Then
a = ActiveCell.Row
Turns = "Turn " & .Cells(a, 2).Value
StartTemp = Int(CDec(.Cells(a, 3).Value))
EndTemp = Int(CDec(.Cells(a, 4).Value))
Set turnCol = .Range("1:1").Find(What:=Turns)
Set startCol = .Range(.Cells(2, turnCol.Column), .Cells(2, turnCol.Column + 35)).Find(What:=StartTemp)
Set endCol = .Range(.Cells(2, turnCol.Column), .Cells(2, turnCol.Column + 35)).Find(What:=EndTemp)
.Range(.Cells(a, startCol.Column), .Cells(a, endCol.Column)).Interior.Color = RGB(255, 0, 0)
End If
End With
End Sub
Currently there's a difference between Excel sheets, having macros enabled and having macros disabled. In order to have something which works on every Excel file, I'd advise you to avoid macros, unless really needed.
In this specific case, macros are not needed indeed: you can solve your issue using conditional formatting:
Conditional formatting
Highlighting rules
Between:
=$C$2
=$D$2
Custom format (Fill with red colour)
Good luck
I'll try (as best I can) to explain the code I'm using
Essentially I have an excel which outputs a value to cell W151 based on a calculation that depends on cells in the range Q149:Q182.
The first step is to reset all the values in the range Q149:Q182 to their base values by copying and pasting from cells S149:S182.
Based on the base values for the formula, I copy and paste the value outputted to W151 into W99
Next, I change the value in Q149 to "2". This updates the calculation and hence the value in cell W151 which I then copy and paste into W100
Then I change Q150 to "2" and again copy the value from W151, this time into W101 and so on and so forth
My question is, is there a way of setting the cells that i'm changing as an array (picked by the user through a prompt), the output cell W151 as a variable (picked by the user through a prompt) and the destination for the copied values (i.e. currently cells W99:W101) as an array also picked by the user via a prompt. If not is there any way you can think of that might automated this process?
I appreciate that I might have done a poor job explaining what I'm trying to do so please feel free to ask for clarifications (although I warn you my VBA knowledge is very limited)
Many Thanks,
Thomas
Sub Example()
Range("S149:S182").Select
Selection.Copy
Range("Q149").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("W151").Select
Selection.Copy
Range("W99").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("Q149").Select
ActiveCell.FormulaR1C1 = "2"
Range("W151").Select
Selection.Copy
Range("W100").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("Q150").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "2"
Range("W151").Select
Selection.Copy
Range("W101").Select
Selection.PasteSpecial Paste:=xlPasteValues
End Sub
Not quite the way I was hoping to do it as this still relies on putting values on the worksheet.
There's one step missing that I didn't understand:
Based on the base values for the formula, I copy and paste the value
outputted to W151 into W99
This is done before you turn the first value to 2. So is it a case of the base average goes into W99, then you change the first value to 2 and that goes into W100. i.e. If you start with 34 values in column Q you'll end with 35 values copied to column W?
Sub Test()
Dim CopyRng As Range
Dim rCell As Range
With ThisWorkbook.Worksheets("Sheet1")
Set CopyRng = .Range("Q149:Q182")
CopyRng.Value = .Range("S149:S182").Value
.Range("W99").Value = .Range("W151").Value
For Each rCell In CopyRng
rCell.Value = 2
'Q149 Offset by -49 rows and +6 columns = cell W100.
rCell.Offset(-49, 6).Value = .Range("W151").Value
Next rCell
End With
End Sub
Edit:
To ask the user to make the selections you could use the following method.
One problem that hasn't been addressed in this code is if the user presses Cancel, but hopefully the link will point you in the right direction - I liked the answer given by #DirkReichel.
Sub Test()
Dim CopyRng As Range
Dim rCalculation As Range
Dim rDestination As Range
Dim rCell As Range
'Creating the base values is a manual operation now.
'CopyRng.Value = Sheet1.Range("S149:S182").Value
Set CopyRng = Application.InputBox("Select range to be evaluated.", Type:=8) 'Q149:Q182
'Calculation must be a single cell.
Do
Set rCalculation = Application.InputBox("Select cell containing calculation.", Type:=8) 'W151
Loop While rCalculation.Cells.Count <> 1
'First cell in destination must be a single cell.
Do
Set rDestination = Application.InputBox("Select first cell to be pasted to.", Type:=8) 'W99
Loop While rDestination.Cells.Count <> 1
rDestination.Value = rCalculation.Value
For Each rCell In CopyRng
rCell.Value = 2
rDestination.Offset(rCell.Row - CopyRng.Row + 1).Value = rCalculation.Value
Next rCell
End Sub
You have lot of unnecessary things in your code simply use inputbox to get the range and use it as required.
Sub Example()
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Application.InputBox("Select range1", Type:=8)
Set rng2 = Application.InputBox("Select range2", Type:=8)
With Sheets("Sheet1")
.Range("Q149:Q182").Value = rng1.Value
.Range("W99").Value = rng2.Value
.Range("Q149").FormulaR1C1 = "2"
.Range("W100").Value = rng2.Value
.Range("Q150").FormulaR1C1 = "2"
.Range("W101").Value = rng2.Value
End With
End Sub
#Thomas first of all welcome!
Make the necessary changes (Sheet name or ranges) and try:
Sub Example()
With (Sheet1) '<= Change Sheet Name if needed
.Range("S149:S182").Copy .Range("Q149")
.Range("W151").Copy .Range("W99")
.Range("W151").Copy .Range("W100")
.Range("W151").Copy .Range("W101")
.Range("Q149").value="2"
.Range("Q150").value = "2"
End With
End Sub
New to VBA
I'm confused as to why I need to run my module twice to get it to update my cells. My code:
Option Explicit
Sub m_Range_End_Method()
Dim lRow As Long
Dim lCol As Long
Dim currentRow As Long
Dim i As Integer
Dim rng As Range
Set rng = ActiveCell
Range("B:B").Select
lRow = Cells(Rows.Count, 1).End(xlUp).Row
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
Sheets("MySheet").Select
' Loop Through Cells to set description in each cell
Do While rng.Value <> Empty
currentRow = ActiveCell.Row
If InStr(rng.Value, "PETROL") = 0 Then
Set rng = rng.Offset(1)
rng.Select
Else
Worksheets("MySheet").Cells(currentRow, 5) = "Shopping"
Worksheets("MySheet").Cells(currentRow, 6) = "Car"
Set rng = rng.Offset(1)
rng.Select
End If
Loop
End Sub
On the first run what happens in Excel 2016 is that Column B gets highlighted and that's it. I then have to press "Run" again in visual basics editor for it to then update all the entries at which point column B gets unselected. All I want to do is update the cells at the currentRow of a specified worksheet. I've been reading but have got myself into some confusion, someone said I should use the
Range("B:B").Select
statement and for some reason the spreadsheet update works but only if I run it twice. Without this Range command, for reasons I don't understand, the spreadsheet doesn't update - all that happens is that the box selection moves to entries with Petrol and stays there with the program running but not updating.
The aim of the program is to find in a sheet all occurrences of a word in column B, in this initial case that is PETROL (I'm going to expand to include many others). For that match on the same row I want it to update columns 5 and 6 with descriptions. The excel spreadsheet will have hundreds of rows of entries with varying descriptions in column B.
Any help would be much appreciated.
I guess you have to run it twice because the first time you run it, the ActiveCell could be anything, and your loop depends on it not being empty to start with, but after the first run you have selected column B (and other things)...
Read this previous answer on avoiding the use of Select and Activate, it will make your code more robust: How to avoid using Select in Excel VBA macros
Revised Code
See the comments for details, here is a cleaner version of your code which should work first time / every time!
Sub m_Range_End_Method()
Dim col As Range
Dim rng As Range
Dim currentRow As Long
' Use a With block to 'Fully Qualify' the ranges to MySheet
With ThisWorkbook.Sheets("MySheet")
' Set col range to the intersection of used range and column B
Set col = Intersect(.UsedRange, .Columns("B"))
' Loop through cells in col to set description in each row
For Each rng In col
currentRow = rng.Row
' Check upper case value match against upper case string
If InStr(UCase(rng.Value), "PETROL") > 0 Then
.Cells(currentRow, 5) = "Shopping"
.Cells(currentRow, 6) = "Car"
End If
Next rng
End With
End Sub
I have a large data set that I'm working with in excel. About 1000+ columns and close to 1 million rows.
My issue is that many of my numbers are formatted as text. To resolve this, I've been using the copy paste > add technique, adding a blank cell.
My problem is that I'm trying to macro this functionality, but I can't figure out how to add a blank cell.
I tried to get crafty and have the macro create a new row, do the add, then delete that row. But, I can't seem to get that to work either.
Anyone have a solution?
Instead of selecting the entire range, you need to select only the cells with values in them. I would suggest the Special Cells function:
Highlight the cell with the #1 in it and COPY that cell
Highlight a column of cells to convert
Press F5 > Goto > Special > Constants (you may have to play with the options here to get only the cells you want)
OK (Now only the cells with values are selected)
Now select Paste Special > Multiply
Using VBA you can conditionally convert the target values to doubles (or another type of your choosing).
Tested example below assumes:
you are working with Sheet1 in ActiveWorkbook
numbers stored as text in column A (1)
converted values to appear in column B (2)
An aside: It's probably always a good idea save your work before running VBA. Cheers, and happy coding.
Option Explicit
Sub convert_to_dbl()
Dim r As Long
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets(1)
For r = 1 To FindLastRow(ws)
With ws
If .Cells(r, 1).Value <> "" Then
.Cells(r, 2).Value = CDbl(.Cells(r, 1).Value)
End If
End With
Next r
End Sub
Function FindLastRow(ws As Worksheet)
Dim LastRow As Long
If WorksheetFunction.CountA(Cells) > 0 Then
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End If
FindLastRow = LastRow
End Function
The following code does what I was looking for.
Sub psAdd()
Dim x As Range 'Just a blank cell for variable
Dim z As Range 'Selection to work with
Set z = Cells
Set x = Range("A65536").End(xlUp).Offset(1)
If x <> "" Then
Exit Sub
Else
x.Copy
z.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd
Application.CutCopyMode = False 'Kill copy mode
End If
x.ClearContents 'Back to normal
End Sub