Basic copy loop problem with range & column iteration - excel

how can i turn the following into a 500x loop?
Range("A14:A6368").Cut Range("B1")
Range("B14:B6368").Cut Range("C1")
Range("C14:C6368").Cut Range("D1")
Basically, I copied a table on the web, when I paste into excel, I get it all in 1 column.
Must be simple, but I've spent hours googling and I cannot find the solution!
Thank you!

Something like the following perhaps:
Dim i As Long
For i = 1 To 500
Range(Cells(14, i), Cells(6368, i)).Cut Destination:=Cells(1, i + 1)
Next
You can also use Offset.
Dim i As Long
For i = 0 To 499
Range("A14:A6368").Offset(, i).Cut Destination:=Range("B1").Offset(, i)
Next

Related

How to redo this single Macro comand over every single row (e.g. from row 2 to row 500)

I'm new programming over VBA; for the moment I have created a single macro for a single row-column; in this particular case for Row "2" and columns "M2:BF2" but I need this MACRO- command to run over the next 320 rows and I do not know how to do it. this is my command:
enter image description here
I will appreciate any advice or guidance,
Best for everybody,
Jorge
Nested for loops are the way to go:
Sub test()
Dim i As Long, j As Long
For i = 2 To 320
For j = 14 To 58 Step 2
If Cells(i, j).Value = 0 Then Cells(i, j).Value = Cells(i, j - 1).Value
Next j
Next i
End Sub
See this for information about loops in VBA.
I suggest you do this using Excel IF(condition, then, else) Formula.. Then once you complete one row, you can copy paste the same formula to all the rows and viola you have the answers.
Incase you insist on doing this using VBA, then you have to use a for loop.
For i = 2 to 320
If Range("N" & i).value = 0 then Range("N" & i).value = Range("M" & i).value
'.... and so on...
Next i

VLOOKUP and search for different n in the same worksheet

[Edited]
I am so sorry I did not describe this very clear:
My question is about the VLookup function:
I used the code like:
B5'n$CX$"
with the intention to let VBA go to the B5 worksheet and also determine which
"n"(either n25 n35 and so on) it has to go to.
This was not working so I am here to seek if I can get any suggestion.
Below is the original post:
I am very newbie in VBA, just started one or two times touching it.
I have modified the code as below, and my objective is to let
VBA find the values for "DI"&i, depending on the values of "DE"&i
in the spreadsheet B5, but in B5, the number "n" which depends on the
values of "CX"&i, and when VBA goes to look up the values of "DE"&i,
it has to determine the value of n firstly with the help of the values
"CX"&i.
The screenshot of the worksheet B5 is as below:
https://www.dropbox.com/s/do6i7zeylaz0sch/B5.jpg?dl=0
My code is as below:
firstly, if "DE"&i >3.9, I would like VBA set "DI"&i = 0,
else with vlookup function.
Thank you very much for any help and advice.
Appreciated.
Sub FindPl()
For i = 2 To 1730
If .Cells("DE" & i).Value > 3.9 Then .Cells("DI" & i).Value = 0
Else: .Cells("DI" & i).Value =
Application.WorksheetFunction.VLookup($DE$" &
i&",'[C:\Users\chenj5\Documents\Meeting_Jan_2019\simulation of Z1.9 for
Ultra Multi-Focal\Meeting 0220\Dataset used for simulation]B5'n$CX$" &
i&", 2, True)
End If
Next cell
Next i
End Sub
Will take a stab at some example code... I guessed on your source data and fixed some syntax errors... spend some time updating and appropriately dimensioning. There is too much going on/wrong with your posted code to provide anything more clear.
Sub FindPl()
dim i as long, wb as workbook, OUTPUTRANGE as range, SEARCHRANGE as range
set wb = "C:\Users\chenj5\Documents\Meeting_Jan_2019\simulation of Z1.9 for Ultra Multi-Focal\Meeting 0220\Dataset used for simulation.xlsx" 'added xlsx extension
with wb
set OUTPUTRANGE = .range(.cells(5,"D"),.cells(100,"D")) 'guessed... the range with the desired output
set SEARCHRANGE = .range(.cells(5,"B"),.cells(100,"B")) 'guessed... the range where you will find .cells(i,"DE")
end with
with activeworkbook.sheets(1) 'FIX THIS TO FIT YOUR NEEDS
For i = 2 To 1730
If .Cells(i, "DE").Value > 3.9 Then 'FIXED SYNTAX ERROR
.Cells(i, "DI").Value = 0
Else:
.Cells(i, "DI").Value = Application.Index(OUTPUTRANGE, Application.Match(.cells(i, "DE").value,SEARCHRANGE, 0))
End If
Next
end with
End Sub

Delete 2 columns based on cell value

I have an Access function built to export a query to Excel. There are spaces for 15 results. Not all of them are used though, so I'd like to delete the blank columns.
I've been trying to search Lrow + 1 for "0.000" and then deleting the entire column, but it isn't working. 0.000 is a formula but I am using .Value method so that shouldn't be the problem, right?
Here's the code I tried to write (but failed miserably):
For Each Cel In wks.Range("C" & Lrow + 1, "V" & Lrow + 1)
If Cel.Value = "0.000" Then
Cel.EntireColumn.Delete
Cel.Offset(0, 1).EntireColumn.Delete
End If
Next Cel
As in the picture, there are 2 results shown. This is what I would like to happen: Search lrow + 1 (the row with 0.000), delete those columns along with the column next to it.
Any help would be appreciated.
A few issues here:
The range reference is wrong as Big Ben pointed out
The comparison is (probably) wrong. I'm guessing the call values are numbers, not strings that look like numbers. So comparing 0 to "0.000" will fail. Use = 0 or if you are worried about small not quite 0 numbers use Absolute value <= 0.0005
The delete logic is flawed, it won't delete the columns you think
.
Set rng = wks.Range("C" & Lrow + 1 & ":V" & Lrow + 1)
For i = rng.Columns.Count To 1 Step -1
If rng.Cells(1, i).HasFormula Then
If Abs(rng.Cells(1, i)) <= 0.0005 Then
Rng.Cells(1, i).Resize(1, 2).EntireColumn.Delete
End If
End If
Next
Don't forget to use Option Explicit and declare all variables

(Excel Vba) Simple Copy & Paste of ranges ,but with random values

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

Return an Index number from a collection VBA

If I have created a collection, can I search search the collection and RETURN THE INDEX number from within the collection?
Due to my newbie status, I can't post screenshots of what I'm trying to do, so let me try to explain what I'm trying to accomplish:
I have a history log from a warehouse database in Excel format that is several thousand lines long-- each line representing a transaction of product moving in or out of as many as 10 different bins. My goal is to identify all the possible different bins in the thousands of lines, copy/transpose those ~10 bins to column headers, and then go through each transaction and copy the transaction quantity (+1,-3, etc) to the correct column, thus being able separate the transactions and more easily identify and generate an accounting of when product moved in/out of each respective bin. This would sort of look like a PivotTable, but that isn't really how it would work.
Here is the code I am working on so far, with comments. My problem is explained in the last comment:
Sub ForensicInventory()
Dim BINLOCAT As Collection
Dim Rng As Range
Dim Cell As Range
Dim sh As Worksheet
Dim vNum As Variant
Dim BINcol As Integer
Dim ACTcol As Integer
Dim QTYcol As Integer
Dim i As Integer
Dim lastrow As Long
Dim x As Long
'This part is used to find the relevant columns that will be used later
BINcol = ActiveSheet.Cells(1, 1).EntireRow.Find(What:="BINLABEL", LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
ACTcol = ActiveSheet.Cells(1, 1).EntireRow.Find(What:="ACTION", LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
QTYcol = ActiveSheet.Cells(1, 1).EntireRow.Find(What:="QUANTITY", LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
i = 0
Set sh = ActiveWorkbook.ActiveSheet
Set Rng = sh.Range(sh.Cells(2, BINcol), sh.Cells(Rows.Count, BINcol).End(xlUp))
Set BINLOCAT = New Collection
'This next section searches the bin column and builds the collection of unique bins that I am interested in.
On Error Resume Next
For Each Cell In Rng.Cells
If Len(Cell.Value) <> 8 And Not IsEmpty(Cell) Then
BINLOCAT.Add Cell.Value, CStr(Cell.Value)
End If
Next Cell
On Error GoTo 0
'Now I take those unique bin names and I put them into a column header on the same spreadsheet, starting in column 10, and spacing every 2 cells thereafter.
For Each vNum In BINLOCAT
Cells(1, 10 + i).Value = vNum
i = i + 2
Next vNum
'Here is where the problem exists for me. This code works and succeeds in copying the QTY
'to column 10, but what I really want to do is determine the index number of the bin from BINLOCAT,
'and use that index number to place the value under the appropriate column header.
For x = 2 To lastrow
Select Case Cells(x, ACTcol).Value
Case "MOVE-IN"
Cells(x, 10).Value = Cells(x, QTYcol).Value
Case "MOVE-OUT"
Cells(x, 10).Value = -Cells(x, QTYcol).Value
Case Else
End Select
Next x
End Sub
In the "For x = 2 to lastrow" loop, I need to find a way to get the INDEX number (1, 2, 3, etc.) from searching for the bin in collection BINLOCAT. BINLOCAT, once created, is static. I envision something like:
neededcolumn = BINLOCAT.item(cells(x,BINcol).value).index (pseudocode)
Then I would replace the 10s in the Case Stmt with "neededcolumn" and this would work.
Maybe I am taking the wrong approach, but it seems to me like I need the collection to be able to do the search portion efficiently. Any thoughts or links to a solution? Based on what I've read, elsewhere, I think that this ability as I'm describing it is not available, but I'm not sure I've understood everything I've read about collections thus far.
Instead of using a for each loop, use a for n = 1 to BINLOCAT.Count loop - then n is your index. Or did I misunderstand?
Disclaimer: Okay, I am going to answer my own question, but I was led to this answer based on #Rory's comment at 13:07 on 8/18. So, thank you, Rory! Rory's answer proper did not enlighten me in the way I needed (or I'm too dumb to see it -- always possible), so I'm not accepting his answer but I want to acknowledge his help. I still suspect there might be a better way than what I am doing, so please feel free to comment/answer/correct me.
In the interest of simplicity and thoroughness, assume the following starting data:
Range("A1:A16")=
BM182B
BM182B
BM182B
BM182B
BM182B
AS662B
BM182B
BM182B
BM182B
BM182B
AS702B
AS642B
BM182B
BM182B
BM182B
BM182B
Based on Rory's comment, this is the first piece of code I came up with:
Sub TestofCollection()
Dim BinCollection1 As Collection
Dim n As Integer
Dim x As Integer
Set BinCollection1 = New Collection
n = 1
On Error Resume Next
For Each Cell In Range("A1:A16")
BinCollection1.Add n, CStr(Cell.Value)
n = n + 1
Next Cell
On Error GoTo 0
For x = 1 To BinCollection1.Count
Range("B" & x).Value = BinCollection1.Item(x)
Next x
End Sub
The problem with this is that output, or the "index" I get, is actually the positional location of each bin during its first occurrence in the list. So the result in the output segment is "1,6,11,12" rather than the desired "1,2,3,4" for the list "BM182B, AS662B, AS702B, AS642B". Whether there is a better way, I do not know, but my solution was to create a "collection of a collection" as follows in the next code:
Sub TestofCollection2()
Dim BinCollection1 As Collection
Dim BinCollection2 As Collection
Set BinCollection1 = New Collection
Set BinCollection2 = New Collection
n = 1
On Error Resume Next
For Each Cell In Range("A1:A16")
BinCollection1.Add Cell.Value, CStr(Cell.Value)
Next Cell
For Each x In BinCollection1
BinCollection2.Add n, BinCollection1.Item(x)
n = n + 1
Next x
On Error GoTo 0
For x = 1 To BinCollection2.Count
Range("C" & x).Value = BinCollection2.Item(x)
Next x
'Test output result should be 3 below
MsgBox "Test Output: " & BinCollection2.Item("as702b")
End Sub
So now, based on this double-collection effort, I can search my multi-thousand line columns of bins and determine their index to create my offset. The index shows up as "1,2,3,4" using those keys in the list.
This is my first question and first answer on Stack Overflow. I will probably give this a couple days to see if anyone has a better answer, but then I will "accept" my own answer here since this is what helped me (can I "unaccept" my answer if a better one shows up later?). Again, comments or suggestions greatly appreciated and accepted. Thank you for viewing.

Resources