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
Related
I have a filter applied to column CK, I am able to select the next visible row from the header by using the following, which also applies a formula into that active cell.
How do I fill that formula down to the bottom, without affecting the hidden rows?
Occasionally there will be no data, so it's just applying a formula to a blank row..
range("CK1").Select
ActiveSheet.range("$A$1").AutoFilter Field:=89, Criteria1:="0"
' Add if formula to find missing carriers based on patterns
Do
ActiveCell.Offset(1, 0).Select
Loop While ActiveCell.EntireRow.Hidden = True
ActiveCell.Formula2R1C1 = _
"=IFS(AND(LEN(RC[1])=18,LEFT(RC[1],2)=""1Z""), ""UPS"", AND(LEN(RC[1])=12,ISNUMBER(RC[1])),""FedEx"",AND(LEN(RC[1])=10,ISNUMBER(RC[1])),""DHL"",AND(LEN(RC[1])=11,LEFT(RC[1],2)=""06""),
It would be great if you could refrain from selecting cells or activating sheets or workbooks like you do. The only time it is fine to have Excel change its selection on screen with VBA is if you want it to.
For your problem, a simple loop will do. Example with CK1 and all the cells below it:
Dim topCell As Range, bottomCell As Range
Set topCell = Range("CK1")
Set bottomCell = topCell.end(xlDown)
'Next test is optional, although recommended (is there no cell filled under CK1?)
If bottomCell.Row >= 1048576 Then 'Current maximal row; you may change the threshold if desired.
Exit Sub
'Alternatively: Exit Function
'Other alternative example: Set bottomCell = Range("CK1000")
End If
Dim c As Range
For Each c In Range(topCell, bottomCell)
If Not c.EntireRow.Hidden Then
c.Formula2R1C1 = "" '<place your formula here>
End If
Next c
situation is following:
I have 32 columns with data (various number of rows in columns) and need to delete cells with .value "downloaded" (always last cell in a column).
I have a code looping from column 32 to 1 and searching last_row for "downloaded" value. For 30 columns code seems to be working flawlessly but 2 columns return last_row value 1 even though there are multiple values (in fact hundreds of them) but they are non existent for VBA code.
Code:
Last_Col = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
last_row = ws.Cells(Rows.Count & Last_Col).End(xlUp).Row
For R = Last_Col To 1 Step -1
With ws
Last_Col = R
last_row = ws.Cells(.Rows.Count & Last_Col).End(xlUp).Row
If Cells(last_row, Last_Col).Value Like "*Downloaded*" Then
Cells(last_row, Last_Col).ClearContents
End If
End With
Next R
Data is being drained from another worksheets. For 2 columns where I experience an error, I manually deleted values and inserted another, random batch of values and code worked as intended.
Checked columns formatting, worksheets from which data is taken but I struggle to find a solution.
Thank you for your help.
Clear Last Cell If Criteria Is Met
The main mistake was using Cells(.Rows.Count & Last_Col), where .Rows.Count & Last_Col would have resulted in a 8 or 9-digit string, while it should have been ws.Cells(ws.Rows.Count, Last_Col).End(xlUp).Row which was pointed out by chris neilsen in the comments.
Another important issue is using ws. in front of .cells, .rows, .columns, .range, aka qualifying objects. If you don't do it and e.g. the wrong worksheet is active, you may get unexpected results.
There is no need for looping backwards unless you are deleting.
Although it allows wild characters (*, ?), the Like operator is case-sensitive (a<>A) unless you use Option Compare Text.
The first solution, using the End property, will fail if a number of last columns is hidden or if you insert a new first row e.g. for a title.
The second solution, using the Find method (and the first solution), may fail if the data is filtered.
The Code
Option Explicit
Sub clearLastEnd()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim LastCol As Long
LastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
Dim LastRow As Long
Dim c As Long
For c = 1 To LastCol
LastRow = ws.Cells(ws.Rows.Count, c).End(xlUp).Row
With ws.Cells(LastRow, c)
If InStr(1, .Value, "Downloaded", vbTextCompare) > 0 Then
.ClearContents
End If
End With
Next c
End Sub
Sub clearLastFind()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim cel As Range
Set cel = ws.Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious)
If Not cel Is Nothing Then
Dim c As Long
For c = 1 To cel.Column
Set cel = Nothing
Set cel = ws.Columns(c).Find(What:="*", _
SearchDirection:=xlPrevious)
If Not cel Is Nothing Then
If InStr(1, cel.Value, "Downloaded", vbTextCompare) > 0 Then
cel.ClearContents
Else
' The current last non-empty cell does not contain criteria.
End If
Else
' Column is empty.
End If
Next c
Else
' Worksheet is empty.
End If
End Sub
EDIT:
So you are curious why it worked at all. The following should shed a light on it:
Sub test()
Dim i As Long
Debug.Print "Right", "Wrong", "Rows.Count & i"
For i = 1 To 32
Debug.Print Cells(Rows.Count, i).Address, _
Cells(Rows.Count & i).Address, Rows.Count & i
Next i
End Sub
In a nutshell, Cells can have 1 or 2 arguments. When 1 argument is used, it refers to the n-th cell of a range, and it 'counts' by row. The more common usage is with 2 arguments: rows, columns. For example:
Cells(5, 10) ' refers to cell `J5`.
Using one argument is inconvenient here:
Cells(16384 * (5-1) + 10)
i.e.
Cells(65546)
It may be convenient when processing a one-column or a one-row range.
Well , let me see if i understand you have a table in worksheet table have 32 columns and X rows (because you only put WS and i can know if is WS=worksheet or WS= Table-range)
for this i am going to say is selection (if you put worksheet only hace to change for it)
in your code put:
Last_Col = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
but in this you always wil obtein 1st cell so i dont understand why exist?
WS.columns.count
return number of columns you selection have
.End(xlToLeft)
return last cell if star to move to left (like Ctrl - left key)
so
Last_Col ---first go to cells (1,ws.Columns.Count) then go to left (End(xlToLeft)) and the end return number of column where finish (.Column) in this case you always get cell (1,"first column of your table")
NOTE: because you wrote that you have allways value in your cells (I have 32 columns with data (various number of rows in columns)
And for Row you have same question
Then you Wrote you want "Delete" but in your code you put Erase value (.ClearContents) so what do you want? because both are no equal
BUT if you have a table and want to search in any cells that have "Download" and only want to "clear content" you just may to use ".find" instead; or if you want to do all at same time you can use .replace (need to check before if .find return "nothing" or no , because if return nothing you get error)
If you have a table with 32 columns and each row have one cell where you put "Donloaded" and want to "delete" all row your code only need select column where appear "downloaded" (example Column "status").
If you have a table where any cell can take value "downloaded" and want to "delete" that cell you need to take care to resize your table and "move to" (when you delete cells you need to say where you want to move yor data remain "letf, "rigth", "up", down).
However if you say that "Downloaded" always appear in last row you can use For to change for all columns and use .end(xlDown)
For i=1 to 32
if cells(1,i).end(xlDown).value="downloaded" then cells(1,i).end(xlDown).ClearContents
next
BUT you need put more information because if you cant garantize that all cells have values and exist cells with "nothing" you will need
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.
I have a list of names, and some code that I would like to run for every single name.
What I'm starting with is this:
Dim cell As Range
For Each cell In Worksheets("Reference").Range("b2:b237")
[rest of my code here]
Next cell
The issue is, what I'm actually trying to do is:
Step 1) Select a name from a drop down list in cell A1
Step 2) There are a bunch of other cells with formulas that reference A1
Step 3) Run code
Step 4) Select next name from drop down list in A1, repeat Steps 2 & 3, until end of list.
Edit: I found something on an old thread that seems to work for what I'm doing:
Sub Macro1()
Sheets("Sheet2").Activate
Range("A1").Select
Do While True
If Selection.Value = "" Then
Exit Do
Else
Selection.Copy
Sheets("Sheet1").Activate
Range("A1").Activate
ActiveSheet.Paste
[rest of my code]
Sheets("Sheet2").Activate
Selection.Offset(1, 0).Select
End If
Loop
End Sub
This should do the job, but if anyone has a more efficient way rather than copying and pasting each value from the list to the cell, that would be very helpful too!
Thank you.
This will take each name in a range and put it into a cell sequentially - you will need to edit to put your sheetnames and ranges in
Sub LoopThroughNames()
dim RangeWithNames as range
'define list of names - needs editing
set RangeWithNames = Worksheets("othersheetname").Range("range with names")
dim TargetCell as range
set TargetCell = worksheets("Sheet with calcs").Range("A1") 'top sheet, cell A1 edit as needed
dim r as range
for each r in RangeWithNames
targetcell= r 'assign name into A1
'do your stuff
next r
End Sub
I am pretty new to VBA and am trying to automate a process at work where I need to extract select cells from an array of 6 sheets and consolidate them in another sheet. The code I have works, but is kinda "clunky" - I am using the excel copy and paste functions, but can't seem to find a good solution away from the copy-and-paste function. And when I try to add a paste special function, I get an 1004 error. Would love advice on optimising this!
For each sheet to be copied, cells are marked in the first column with "1", "0" or left blank - if the cells are "1" or "0", I copy the other cells in the row to the consolidated sheet. There are some gaps in between rows, so I opted to use a For-Loop instead of a Do-While statement.
I've attached the code as follows:
Sub TEST()
Dim i As Integer 'copying row counter for each sheet to be copied
Dim j As Integer 'pasting row counter in consolidated sheet
Dim cal(1 To 6) As String 'copied sheetname
cal(1) = "Picks"
cal(2) = "Eats"
cal(3) = "Night Out"
cal(4) = "Active"
cal(5) = "Family"
cal(6) = "Arts"
Dim x As Integer
Dim y As Integer 'column for date
Dim z As Integer 'max row to run till
y = 1 'column checked in each sheet where condition for copying is met
z = 300 'number of rows to check in each sheet
j = 1
For x = 1 To 6
For i = 1 To z
If Sheets(cal(x)).Cells(i, y) = "0" Or Sheets(cal(x)).Cells(i, y) = "1" Then
Sheets(cal(x)).Select
Range(Sheets(cal(x)).Cells(i, 2), Sheets(cal(x)).Cells(i, 10)).Select
Selection.Copy
Application.Goto ActiveWorkbook.Sheets(Consolidated).Cells(j, 1)
ActiveSheet.Paste
Else
j = j - 1
End If
j = j + 1
Next i
Next x
End Sub
Again I would love to optimise this code, using another method instead of copy-and-paste. Also I tried:
Application.Goto ActiveWorkbook.Sheets(Consolidated).Cells(j, 1)
ActiveSheet.PasteSpecial Operation:=xlPasteValues
Which resulted in a 1004 error. Would love to know what went wrong.
You're getting the error because you're attempting to paste into the activesheet instead of into a range on the activesheet, and because you have the wrong argument for the PasteSpecial method.
This will work, although it's not what you want to do: (see CopyWithoutClipboard further below for a better alternative)
Sub PasteIntoGoto()
Sheets("sheet1").Range("A1").Copy
Application.Goto ActiveWorkbook.Sheets("Sheet3").Cells(1, 1)
ActiveSheet.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
End Sub
Note the range inserted in between ActiveSheet and PasteSpecial and Paste:= instead of Operation:=.
You're right in wanting to optimize your code. Maybe the most important guideline in Excel VBA development is to never select anything, which can cause all kinds of problems. In your first example, you are using .Select explicitly, and in the second example, .GoTo is effectively doing the same thing.
Rather than selecting a sheet, copying a range, selecting another sheet, and pasting into another range, you can write a copy of the data to the target range (either on the same sheet or on another one) like this:
Sub CopyWithoutClipboard()
Sheets("sheet1").Range("A1").Copy Sheets("sheet2").Range("A1")
End Sub
Obviously you can use variables in place of the hard-coded objects in the snippet above.