I've been using Columns(2).Copy Destination:=Columns(1) provisionally to offset all cells that contain "x" one column to the left, however it seems to be very memory consuming and not very reliable as I can't choose to offset only "x" values.
Is there any way I can make only the cells on which this contition was met to be offset, and on a more efficient way?
Similar to the below answer, but with a For-Each loop and for the whole range:
Sub MoveOver()
Dim rng As Range
Dim c As Range
Set rng = ThisWorkbook.Worksheets("Sheet1").Range("B:B")
For Each c In rng
If c.Value = "x" Then c.Offset(0, -1) = c.Value
Next c
End Sub
you would probably want to try something like this
For i = 1 To 100
If ActiveSheet.Cells(i, 2).Value = "x" Then
ActiveSheet.Cells(i, 1).Value = ActiveSheet.Cells(i, 2).Value
End If
Next
just set the 100 for however many rows you have. I'm not even sure this would run any faster than what you have. Unless I am missing your goal here.
and if you want to go through all cells in the sheet
For Each rcell In ActiveSheet.Cells
If recll.Column >= 1 And rcell.Value = "x" Then
ActiveSheet.Cells(rcell.Row, rcell.Column - 1).Value = ActiveSheet.Cells(rcell.Row, rcell.Column).Value
End If
Next
but this one would presumably take a really long time. Ideally you should use nested loops if you know the last row and column you are using. This way you only iterate of cells that you believe contain data.
Related
I have this function which manages to remove all numbers stored as text:
Public Function find_numbers_formated_as_text(ByVal sh As Worksheet)
Dim c As Range
On Error GoTo A
''''For Each r In sh.UsedRange.Cells.SpecialCells(xlCellTypeConstants, xlTextValues)
For Each c In sh.ListObjects(1).DataBodyRange
''''For Each c In sh.UsedRange.Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
''''For Each c In sh.ListObjects(1).DataBodyRange.Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
If IsNumeric(c.Value) = True Then
c.Value = c.Value
End If
Next c
Exit Function
A:
On Error GoTo 0
End Function
But it is really slow... Does anyone have any suggestion on how to make it faster?
I did try some other things which is why there are some of the comments in the source code. But comments didn't work, because range was also empty in my case (even if table was full of data).
Please, replace this part of your code:
For Each C In sh.ListObjects(1).DataBodyRange
''''For Each c In sh.UsedRange.Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
''''For Each c In sh.ListObjects(1).DataBodyRange.Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
If IsNumeric(C.Value) = True Then
C.Value = C.Value
End If
Next C
with this one:
Dim lRng As Range, arr, i As Long, j As Long
Set lRng = sh.ListObjects(1).DataBodyRange
arr = lRng.Value2
For i = 1 To UBound(arr)
For j = 1 To UBound(arr, 2)
If IsNumeric(arr(i, j)) Then arr(i, j) = CDbl(arr(i, j))
Next j
Next i
With lRng
.NumberFormat = "General"
.Value2 = arr
End With
It places the range in an array and all process take place only in memory, the modified array content being dropped at the end of the code, at once.
The most time consuming is the iteration between each cell and writing cell bay cell...
If "General" formatting may bother your list object format, please state in which columns the conversion should be done, and I will adapt the code to format only the respective table columns.
Now I could see one of your comments saying that in the range to be processed exist (and must remain) formulas. The above code does not deal with such a situation. You should state it in your question, I think...
Edited:
If the formulas used to return a numeric value (not a string) and, by mistake the respective range has been formatted as Text, you can try the next way (to maintain the formulas):
With sh.ListObjects(1).DataBodyRange
.NumberFormat = "General"
.Formula = .Formula
End With
There are lots of answers to this question. This is a simple thing to try. Add this before:
Application.Calculation = xlManual
and this after:
Application.Calculation = xlAutomatic
It's faster to store the range as array than changing values in the sheet.
sh.ListObjects(1).DataBodyRange.formula = sh.ListObjects(1).DataBodyRange.formula
The numbers will default to numbers if they were text so you don't need to test if it's number.
(You will not lose formulas using this method.)
I'm trying to find an easy way to get rid of 'bad' rows in my worksheet, which has 3780 rows. Instead of scanning through and deleting each rows every time, which is time consuming, I was wondering if there was an easier way?
Perhaps by making a macro that highlights cells in a column range (A-L) every time it finds the bad value (e.g. 'Apple') in a cell located in every row.
Something along the lines of:
If =ISTEXT() then delete row
I hope this makes sense, let me know if not.
This small macro will search for the presence of apple in any cell in columns A through L and delete that row:
Sub KillBadApple()
Dim rng As Range
Set rng = Intersect(ActiveSheet.UsedRange, Range("A:L"))
nLastRow = rng.Rows.Count + rng.Row - 1
nFirstRow = rng.Row
For i = nLastRow To nFirstRow Step -1
exam = ""
For j = 1 To 12
exam = exam & Chr(1) & Cells(i, j).Text
Next j
exam = LCase(exam)
If InStr(exam, "apple") > 0 Then
Cells(i, j).EntireRow.Delete
End If
Next i
End Sub
Thanks to a previous post and some excellent direction I was able to create successfully working code for my needs. However, the table/data has changed a bit and I have not yet reached my ultimate goal of iterating the paste function based on another cell's value. I have seen this post on SO but it has not helped me. I found other resources on using loops in Excel VBA and created the very simple Do While code you see below.
My problem: I cannot get the code to stop looping when it reaches the value from Column F. It finds the first available case and outputs the correct information endlessly without stopping at n value and moving on.
Here is a look at the data table:
A B C D E F
R1 Name Num Status #Orig #Act #Rem
R2 ABC 032 Complete 22 0 11
R3 LMN 035 In Prog 25 21 4
Here is my code:
Sub Copy_Pending_Status()
Dim srcrange As Range
Dim wb As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim i As Integer
Set wb = ActiveWorkbook
Set ws1 = wb.Worksheets("SIS Agregate")
Set ws2 = wb.Worksheets("Center Detail")
Set srcrange = ws2.Range("C2:C61")
For Each Row In srcrange.Cells
Select Case Row.Value
Case "In Progress"
Do While i <= Row.Offset(0, 3).Value
Set LastCell = ws1.Cells(ws1.Rows.Count, "C").End(xlUp).Offset(1)
LastCell.Offset(0, 0).Value = Row.Offset(0, -2).Value
LastCell.Offset(0, 12).Value = Row.Offset(0, -1).Value
LastCell.Offset(0, 4).Value = "Not Yet Scanned"
Loop
Case "Complete"
Do While i <= Row.Offset(0, 3).Value
Set LastCell = ws1.Cells(ws1.Rows.Count, "C").End(xlUp).Offset(1)
LastCell.Offset(0, 0).Value = Row.Offset(0, -2).Value
LastCell.Offset(0, 12).Value = Row.Offset(0, -1).Value
LastCell.Offset(0, 4).Value = "Purged"
Loop
End Select
Next Row
End Sub
I have tried setting the Do While i <= Row.Offset(0, 3).Value to (0,3) (0,4) and (0,6) as I am not sure if it is counting the number of columns from "A" as one, "C" as one, or "C" as zero and offset is three (to the right).
I want to note that eliminating the Do While and Loop lines of code from each case make this function correctly, but only once per row, per case - as opposed to however many times Column F indicates.
Have I oversimplified this and am missing some obvious key information? What change do I need to make to get this little loop to function correctly?
Nothing within your loops changes the value of i, and so the "Do While" conditions are always met. You need to iterate through values of i so that eventually the conditions will not be met. At the end of each loop, add:
i = i + 1
This will allow it to count how many times the loop has been run and stop after a set number of iterations based on Column F.
You'll also want to re-set i to zero in between each row. Do this between "End Select" and "Next Row":
End Select
i = 0
Next Row
I am cycling through values on a pending data list and then updating a master list if any of those values are new. The pending list will normally have 100-200 rows of data and each row will have about 10 variables that it will need to make sure are updated on the master list. The Master list is about 10,000 rows.
I have written code that will loop through each row of the pending list, assign values to variables and then perform a find on the master list looking for a matching record and then update it accordingly. My code works fine and does exactly what I want but the processing time is about 4 minutes and that's 3 minutes and 50 seconds longer than the people that use it are willing to allow without complaining.
Is there alternative coding that I could use to help decrease processing time?
The code I have is very long and so I am not going to paste it all here but instead paste snip-its of it so you can have an idea of what I am currently doing:
Application.Screenupdating = False
Applicaiton.Enableevents = False
Application.Calculation = xlCalculationManual
PendingBRow = ThisWorkbook.Sheets("PendingLog").Range("A65000").End(xlUp).Row
MasterBRow = ThisWorkbook.Sheets("MasterLog").Range("A65000").End(xlUp).Row
For D = 2 To PendingBRow
With ThisWorkbook.Sheets("PendingLog").Range("A" & D)
PendingRecordNumber = .Value
PendingIR = .offset(0, 5).Value
PendingVal = .offset(0, 6).Value
End With
With ThisWorkbook.Sheets("MasterLog").Range("B2:B" & MasterBRow)
Set c = .Find(PendingRecordNumber, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
DaysSinceLastWorkedStatic = c.offset(0, 22).Value
MasterIRValue = c.offset(0, 16).Value
If PendingIR <> 0 Then
If PendingIR <> MasterIRValue Then
c.offset(0, 16).Value = PendingIR
DaysSinceLastWorkedStatic = 0
c.offset(0, 22).Value = DateVal
End If
End If
c.offset(0, 24).Value = POorLA
c.offset(0, 25).Value = FinalizedFlag
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress ' in rare cases a record number could be duplicated on the master list.
end if
end with
ThisWorkbook.Sheets("PendingLog").Range("A" & D).offset(0, 15).Value = DaysSinceLastWorkedStatic
Next D
One alternative I had considered was to filter the master list by the record number and update the visible row only and then unfilter for each record number on the pending list. I have not yet tested this method.
Could this method be better than what I have?
So I dont know if this will be an answer but I think this might at least give you a look at another type of find/update code.
This is used to update the times people are scheduled to work
In this example I have a Row A with Names B with Times. I paste the updated Name and Time in rows H and I. Some times its all 98 some times it just 5 and this program looks at the list finds the name and takes the time from I and writes it over its corresponding time in B.
Option Explicit
Sub Update_Holiday()
Dim ws As Worksheet
Dim SrcRng As Range
Dim schRng As Range
Dim c As Range
Dim search As Range
Set ws = ThisWorkbook.Sheets(3)
Set SrcRng = ws.Range("H2:H98")
Set schRng = ws.Range("A2:A98")
For Each c In SrcRng
Set search = schRng.Find(c.Value, LookIn:=xlValues, SearchDirection:=xlNext)
If Not search Is Nothing Then
c.Offset(, 1).Copy search.Offset(, 1)
End If
Next c
End Sub
This is one of those things that I'm sure there's a built-in function for (and I may well have been told it in the past), but I'm scratching my head to remember it.
How do I loop through each row of a multi-column range using Excel VBA? All the tutorials I've been searching up seem only to mention working through a one-dimensional range...
Dim a As Range, b As Range
Set a = Selection
For Each b In a.Rows
MsgBox b.Address
Next
Something like this:
Dim rng As Range
Dim row As Range
Dim cell As Range
Set rng = Range("A1:C2")
For Each row In rng.Rows
For Each cell in row.Cells
'Do Something
Next cell
Next row
Just stumbled upon this and thought I would suggest my solution. I typically like to use the built in functionality of assigning a range to an multi-dim array (I guess it's also the JS Programmer in me).
I frequently write code like this:
Sub arrayBuilder()
myarray = Range("A1:D4")
'unlike most VBA Arrays, this array doesn't need to be declared and will be automatically dimensioned
For i = 1 To UBound(myarray)
For j = 1 To UBound(myarray, 2)
Debug.Print (myarray(i, j))
Next j
Next i
End Sub
Assigning ranges to variables is a very powerful way to manipulate data in VBA.
In Loops, I always prefer to use the Cells class, using the R1C1 reference method, like this:
Cells(rr, col).Formula = ...
This allows me to quickly and easily loop over a Range of cells easily:
Dim r As Long
Dim c As Long
c = GetTargetColumn() ' Or you could just set this manually, like: c = 1
With Sheet1 ' <-- You should always qualify a range with a sheet!
For r = 1 To 10 ' Or 1 To (Ubound(MyListOfStuff) + 1)
' Here we're looping over all the cells in rows 1 to 10, in Column "c"
.Cells(r, c).Value = MyListOfStuff(r)
'---- or ----
'...to easily copy from one place to another (even with an offset of rows and columns)
.Cells(r, c).Value = Sheet2.Cells(r + 3, 17).Value
Next r
End With