I cannt understand, why my excel script does not work anymore..
I need to do simple copy Paste function,
First, I have 1 value (Mean) which is generated and it changes randomly after any action (Very important point!)
So , I need a kind of "simulation", means to copy the value and put it in another worksheet, after that the excel is refreshing automatically and I get a new mean-value..
This process should be repeated 1000 times. It means i will have 1000 different values at the end, because of random changes of my mean-value
I have a script, which works perfect for this purpose.
Dim i As Integer
Sheets("Worksheet2").Select
Cells(4, 23).Select
Selection.Copy
'
Sheets("Worksheet3").Select
For i = 1 To 1000
Cells(1 + i, 1).PasteSpecial Paste:=xlPasteValues
Next i
'
End Sub
Now,
I have not only one cell (my mean-value) but two! ( median from the same data)
It means, now it should copy two cells simultaneously (range) and paste than in the new worksheet, in the new range.
So, it is the same process, like in my script, but with two cells
a kind of this..
Dim i As Integer
Sheets("Fracht Modell Roh").Select
Range("W4:X4").Select
Selection.Copy
'
Sheets("Ergebnisse").Select
For i = 1 To 100
Range("A2:B2" & 1 + i).PasteSpecial Paste:=xlPasteValues
Application.CalculateFull
Next i
'
End Sub
I tried to do it with range() BUT!!! it doesnt refresh my mean and median values anymore ... or something else... so I get 1000 times the SAME!! value after the script running.
I can not understand, what is his problem. Why in first case it works perfect, and if I do the same task with range, it seems to copy the same value about 1000 times, but not refreshing or changing it.
pleas, I hope, anybody could help me
thank you very much!
I think you meant to write this:
Dim i As Integer
Sheets("Fracht Modell Roh").Select
Range("W4:X4").Select
Selection.Copy
'
Sheets("Ergebnisse").Select
For i = 1 To 1000
Range("A" & i + 1 & ":B" & i + 1).PasteSpecial Paste:=xlPasteValues
Next i
However, your code doesn't need the Select statement to work, that will just let the code jump through sheets over and over without reasons. I might rather write it like this:
Dim i As Integer
Sheets("Fracht Modell Roh").Range("W4:X4").Copy
'
With Sheets("Ergebnisse")
For i = 1 To 1000
.Range("A" & i + 1 & ":B" & i + 1).PasteSpecial Paste:=xlPasteValues
Next i
End With
Same thing for your other code snippet, the one for a single random value:
Dim i As Integer
Sheets("Worksheet2").Cells(4, 23).Copy
'
With Sheets("Worksheet3")
For i = 1 To 1000
.Cells(1 + i, 1).PasteSpecial Paste:=xlPasteValues
Next i
End With
Moreover, if as I imagine the two cells in the first sheet contains two random functions =RAND(), why you don't directly write them in VBA?
With Sheets("Ergebnisse")
For i = 1 To 1000
.Range("A" & i + 1).Value = Rnd
.Range("B" & i + 1).Value = Rnd
Next i
End With
Related
I have a sheet of data. I apply the autofilter. Now, I want to copy and paste that particular data only the visible lines. I'm using the command UsedRange.SpecialCells(xlCellTypeVisible).Copy and it is now working. Is there any other way to do this? or a workaround?
this is my code
ws1.Activate
ws1.Cells(1, 1).Select
'to count how many lines are on the sheet
LastRow = ws1.Range("A1").CurrentRegion.Rows.Count
'lets use the last row to build the range that I need to filter
myrange = CStr(LastRow)
'I filter the range on the sheet by 0.14
ws1.Range("A1:O" & myrange).AutoFilter Field:=8, Criteria1:="0.14"
'this counts the data(rows) visible after applying the filter and -1 means minus the header
Rowz = ws1.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
'this will copy the filtered data into the following range
'I get the error in this line of code. dont know what wrong
ws1.UsedRange.SpecialCells(xlCellTypeVisible).Copy Range("A" & CStr(LastRow + 1) & ":O" & CStr(LastRow + 1))
'I tried as well
ws1.UsedRange.SpecialCells(xlCellTypeVisible).Copy Range("A" & CStr(LastRow + 1) & ":O" & CStr(LastRow + 1 + Rowz))
any ideas are welcome :)
I'm trying to optimize code that will delete rows that meet certain criteria. I have working code, but the following code creates 7 seconds of wait time to execute:
Dim j As Long
For j = 2 To Rows.Count
If (Range("J" & j).Value <> "") Then
Range("A" & j & ":R" & j).Select
Selection.Delete Shift:=xlUp
End If
Next j
The following code runs instantly; however, I can't get it to work once j = 2. What code needs to be added to stop the loop before it deletes the column headers in row 1?
' Delete rows where column J is not blank
For j = Range("J" & Rows.Count).End(xlUp).Row To 1 Step -1
If (Range("J" & j).Value <> "") Then
Range("A" & j & ":R" & j).Select
Selection.Delete Shift:=xlUp
End If
Next j
As mentioned in the comments, you should looking backward for deletions. If you do the deletions from row#2 to the last row, there might be some rows should be deleted but remained there. Take this for example, assuming we are going to delete row#3 and row#4. If we do it forward, the row#4 becomes to new row#3 after deleting old row#3. And the next row to be checked is row#4, that is the original row#5. So the data in row#4 is actually in row#3 now and it'll never be deleted.
However, when your data is quite massive, the deletions would take so many resource that it drags down the speed. It would be better to find all the ranges to be deleted and delete them at once in the end. We can do it by Union method. And this can also prevent the problem mentioned before, so we can do it forward as other loops.
Lastly, you can avoid selecting ranges since it is not so efficient. Range().Delete can simply delete the range and without selecting it.
The code would be like this.
'pseudo code
Sub deletion()
For i = 2 To lastrow
If shouldBeDeleted Then
If deletingRng Is Nothing Then
Set deletingRng = Cells(i, X)
Else
Set deletingRng = Union(deletingRng, Cells(i, X)
End If
End If
Next i
deletingRng.Delete Shift:=xlUp
End Sub
I am trying to copy cells B48:B52 and then paste in cells B55:B59, and then paste the same data again but with two rows in between (so now in cells B62:B66). Need to do this in a loop so that it pastes the range ~1100 times.
I'm sure there is a way to do this with VBA but cannot figure it out. Any helpers?
I think this is what you are looking for:
Sub paste_each_n()
t = 48
Count = 1
Do Until Count = 1100
Range("B" & t & ":B" & t + 4).Copy
Cells(t + 7, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues
t = t + 7
Count = Count + 1
Loop
End Sub
I have an Excel project which has a few thousand rows containing strings which need sorting out.
Typically one cell in each row should have a six digit number 123456 but many are 123456/123456/234567 etc. which need to have the / deleted and then be separated onto individual rows. There is other information in the surrounding columns which needs to stay with these six digit numbers.
I decided to approach this by firstly making copies of the rows the appropriate number of times and then deleting the surplus information
This code below deals with the copying part and it works.. but it's really slow. Is there a quicker way to achieve what I'm trying to do?
Thanks for any help.
Chris
Sub Copy_extra_rows()
Application.ScreenUpdating = False
s = 2
Do Until s = Range("N20000").End(xlUp).Row
'checks for / in Mod list
If InStr(1, Range("N" & s), "/") Then
'determines number of /
x = Len(Range("N" & s)) - Len(Replace(Range("N" & s), "/", ""))
'loops x times and copies new row
For a = 1 To x
Range("J" & s & ":O" & s).Select
Selection.Copy
Range("J" & s + 1).Select
Selection.Insert Shift:=xlDown
s = s + 1
Next a
Else
End If
s = s + 1
Loop
End Sub
I would have approached this differently to optimize the process and improve the overall efficiency of code.
Firstly, I would load the entire column into an array. This way it's always faster to access the elements of that array rather then referring Cells() multiple times in loops. Working with objects in memory is much faster because your client doesn't need to for example update the UI. Generally, arrays big O is O(1) which means you instantly can access an object/data stored at a specific index.
Let's consider an SSCCE.
Then the code (*Note: I have added comments in the code in the right places, hopefully that helps you understand what is going on)
Sub Main()
Dim columnArray As Variant
' create an array from Range starting at L2 to the last row filled with data
columnArray = Range("N2:N" & Range("N" & Rows.Count).End(xlUp).Row)
Dim c As New Collection
' add separate 6 digit numbers to the collection as separate items
' iterate the columnArray array and split the contents
Dim element As Variant
For Each element In columnArray
If NeedSplitting(element) Then
Dim splittedElements As Variant
splittedElements = Split(element, "/")
Dim splittedElement As Variant
For Each splittedElement In splittedElements
c.Add splittedElement
Next
Else
c.Add element
End If
Next
' print the collection to column Q
PrintToColumn c, "Q"
End Sub
Private Sub PrintToColumn(c As Collection, ByVal toColumn As String)
Application.ScreenUpdating = False
' clear the column before printing
Columns(toColumn).ClearContents
' iterate collection and print each item on a new row in the specified column
Dim element As Variant
For Each element In c
Range(toColumn & Range(toColumn & Rows.Count).End(xlUp).Row + 1) = element
Next
Application.ScreenUpdating = True
End Sub
Private Function NeedSplitting(cell As Variant) As Boolean
' returns true if the cell needs splitting
If UBound(Split(cell, "/")) > 0 Then
NeedSplitting = True
End If
End Function
After running the code all your numbers should appear as separate elements in column Q
NOTE: Why use a Collection?
Collections in VBA are dynamic. It means you don't have to know the size of a collection in order to use it - unlike arrays. You can re-dim your array multiple times to increase its size but that's rather considered a bad practice. You can add nearly as many items to a Collection as you want with a simple Collection.Add method and you don't have to worry about increasing the size manually - it's all done for you automatically. In this scenario the processing happens in memory so it should be much quicker then replacing cells contents inside a loop.
Try this:
Dim s As Integer
Dim splitted_array() As String
s = 2 'Assuming data starts at row 2
Do Until Range("N" & s).Value = vbNullString Or s >= Rows.Count
'Split the array
splitted_array = Split(Range("N" & s).Value, "/")
If UBound(splitted_array) > 0 Then
'Set the first value on the first row
Range("N" & s).Value = splitted_array(0)
For i = 1 To UBound(splitted_array)
'Add subsequent rows
Rows(s + i).Insert xlDown
Range("J" & s + i & ":O" & s + i).Value = Range("J" & s & ":O" & s).Value
Range("N" & s + i).Value = splitted_array(i)
Next
End If
s = s + 1 + UBound(splitted_array)
Loop
This code turns this:
into this:
In column A, I'm trying to duplicate the cell value in for the next 61 rows. Below is my attempt, but it doesn't seem to be working. I guess I'm not sure how to duplicate the cell values. Thanks for any suggestions, as I would like to automate this since the spreadsheet has over 300,000 rows.
Sub AnotherAttempt()
'
' AnotherAttempt Macro
'
' Keyboard Shortcut: Ctrl+r
'
iLoop = 2000
For i = 1 To iLoop
j = i - 1
Selection.AutoFill Destination:=Range("A4652 + 62*j:A4652 + 62*i - 1")
Next i
End Sub
Not clear for me what's the idea here, but for sure one thing is wrong... the way you're using j and i values. It should be like this:
Selection.AutoFill Destination:=Range("A" & 4652 + 62*j & ":A" & 4652 + 62*i - 1)
The maths should be done out of the string.