This is what I'm going for, but I'm pretty green when it comes to loops:
If (G1<>"", InputBox for a multiplier for range G2:G's LastRow,"")
Loop through column BZ1 (or preferably, the last column)
Or:
G1:BZ1 each contain the name of an order set. I need to manually enter the number of times each order set will be used. D2:D1001 are the number of times an item occurs in each set. I need to multiply D2:D1001 by the input box's number and enter that result for each item into G2:G1001.
I have multiple order sets and need to multiple each one by a different number of stores every time that this macro will be run. Order sets are in the columns, items are in the rows.
This should do the trick - just change that Sheet1 to whatever your sheet's name is.
So first we get the last column of data to use for our first loop (by getting the value of lastcol), then we start looping through the columns. We assign a value to multiplier through the InputBox, and after that we loop through every cell in the column and multiply it by the number you entered. Then we move on to the next column until we've run out of data.
I've updated the text in the InputBox to display the header text for each column each time.
Sub Test()
Dim sht As Worksheet, lastcol As Long, lastrow As Long, multiplier As Integer
Set sht = ThisWorkbook.Worksheets("Sheet1")
lastcol = sht.Cells(1, sht.Columns.Count).End(xlToLeft).Column
For i = 7 To lastcol
If Cells(1, i) <> vbNullString Then
multiplier = InputBox("Number of stores using set " & Cells(1, i) & ".")
lastrow = sht.Cells(sht.Rows.Count, 4).End(xlUp).Row
For j = 2 To lastrow
On Error Resume Next
Cells(j, i).Value = Cells(j, 4).Value * multiplier
On Error GoTo 0
Next j
End If
Next i
End Sub
Related
I am working on a code and all I want to do is copy data from one sheet and paste it into another sheet that has a table setup.
My code is doing exactly what I want it to do but, the table doesn't resize to include all the rows that was copied, only the first row of the copied data goes into the table. and the rest are formatted as not in the table.
This is how it looks like after I run the code
Sub LastRowInOneColumn()
Dim LastRow As Longenter image description here
Dim i As Long, j As Long
'Find the last used row in a Column
With Worksheets("First Page")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
'first row number where you need to paste values in Sheet1'
With Worksheets("Report")
j = .Cells(.Rows.Count, "A").End(xlUp).Row '+ 1
End With
For i = 1 To LastRow
With Worksheets("First Page")
'If .Cells(i, 1).Value = "X" Then
.Rows(i).Copy Destination:=Worksheets("Report").range("A" & j)
j = j + 1
'End If
End With
Next i
End Sub
Usually, inserting below the end of the table will make it grow automatically, but not when pasting a range that exceeds the number of columns in the table. There are two ways to deal with this:
1- limit the copied range to the number of columns in the table; i.e.
.Rows(i).Resize(,4).Copy Destination:=Worksheets("Report").range("A" & j)
' ^^^^^^^^^^^
2- Explicitly resizing the table, using the method ListObject.Resize; i.e.
With Sheet1.ListObjects(1)
.Resize .Range.Resize(.Range.Rows.count + 1)
End With
So I'm hoping for some help to automate a process that will otherwise involve copying and editing some 10,000 rows.
This is stuff relating to location data. Essentially, there are tons of these Master Rows but they do not have individual rows for Unit Numbers. I am hoping to get something to expand these into individual Unit Number rows based on what is in Column N. Column N is intended to follow a strict format of being a comma-seperated single cell list for each row.
Below is an example from Sheet 1 of what each row will have and needs to be expanded upon. Note that Column N is green and follows a consistent formatting and this will be the determinant for how many times these rows will each be expanded upon.
Below is Sheet 2 and what I want the VBA to create from Sheet 1. You can see that each row has been expanded based on the contents of Column N from Sheet 1.
Like I said, it is expected that this will involve some several thousand rows to create.
Option Explicit
Sub Tester()
Dim sht1, sht2, rwSrc As Range, rwDest As Range, v, arr, n
Set sht1 = ThisWorkbook.Sheets("Sheet1")
Set sht2 = ThisWorkbook.Sheets("Sheet2")
sht2.Range("A2:M2").Resize(3, 13).Value = sht1.Range("A2:M2").Value
Set rwDest = sht2.Range("A2:M2") 'destination start row
Set rwSrc = sht1.Range("A2:M2") 'source row
Do While Application.CountA(rwSrc) > 0
v = rwSrc.EntireRow.Cells(1, "N").Value 'list of values
If InStr(v, ",") > 0 Then
'list of values: split and count
arr = Split(v, ",")
n = UBound(arr) + 1
Else
'one or no value
arr = Array(v)
n = 1
End If
'duplicate source row as required
rwDest.Resize(n, 13).Value = rwSrc.Value
'copy over the unit values
rwDest.Cells(1, "G").Resize(n, 1).Value = Application.Transpose(arr)
'offset to next destination row
Set rwDest = rwDest.Offset(n, 0)
'next source row
Set rwSrc = rwSrc.Offset(1, 0)
Loop
End Sub
This does the work in same sheet... Pls copy the value to "Sheet2" before executing this. Not sure about efficiency though.
Public Sub Test()
Dim lr As Long ' To store the last row of the data range
Dim counter As Long
Dim Str As String ' To store the string in column N
lr = Range("N65536").End(xlUp).Row 'Getting the last row of the data
For i = lr To 2 Step -1
Str = Range("N" & i).Value ' Getting the value from Column N
counter = 1
For Each s In Split(Str, ",")
If counter > 1 Then
Range("A" & (i + counter - 1)).EntireRow.Insert ' Inserting rows for each value in column N
Range("G" & (i + counter - 1)).Formula = s ' Updating the value in Column G
Else
Range("G" & i).Formula = s ' No need to insert a new row for first value
End If
counter = counter + 1
Next s
Next i
lr = Range("G65536").End(xlUp).Row
' Pulling down other values from the first value row other rows
Range("A1:N" & lr).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"
' Pasting the data as Values to avoid future formula issues.
Range("A1:N" & lr).Copy
Range("A1:N" & lr).PasteSpecial xlPasteValues
MsgBox "Done"
End Sub
I'm trying to copy an entire row by index number and paste it to another row with a different index number when a certain condition is met (I know the issue is not with the conditional logic). I'm thinking of something like this:
Sub Makro1()
Dim i As Integer
With ActiveSheet
'for looping
totalRows = .Cells(.Rows.Count, "A").End(xlUp).Row
'index of last row even after rows have been added
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'data starts at row #3
For i = 3 To totalRows
If .Cells(i, 19).Value > 0 Then
Number = .Cells(i, 19).Value
Do While Number > 0
lastRow = lasRow + 1
'Next line doesnt do anything
.Rows(lastRow) = .Rows(i).Value
Number = Number - 1
Loop
End If
Next i
End With
End Sub
The logic works like its supposed to but no lines are pasted. I've gone step by step and am certain the problem is not with the logic.
I assume that you want to copy Rows(i) and paste it as value in Rows(lastRow). So, you need to replace this line
.Rows(lastRow) = .Rows(i).Value
with these two lines:
.Rows(i).Copy
.Rows(lastRow).PasteSpecial xlPasteValues
Or
.Rows(lastRow).Copy
.Rows(i).PasteSpecial xlPasteValues
if you want to copy Rows(lastRow) and paste it as value in Rows(i).
Edit:
To paste everything (formulas + values + formats), use paste type as xlPasteAll.
Reference: msdn
Range Copy and Paste
Syntax
Range().Copy [Destination]
The square brackets indicate that Destination is an optional parameter. If you don't designate a Destination range it copies the selection to the clipboard. Otherwise it copies the first range directly to the new location.
Change this line:
.Rows(lastRow) = .Rows(i).Value
To:
.Rows(lastRow).copy .Rows(i)
It's worth noting that
.Rows(lastRow).copy .Cells(i, 1)
Will also work. Excel will resize the Destination range to fit the new data.
your code works for me
so just add a breakpoint at .Rows(lastRow) = .Rows(i).Value statement and then query all relevant variables value in the Immediate Window, like:
?lastRow
?.Rows(lastRow).Address
?i
?.Rows(i).Address
in the meanwhile you could
add Option Explicit statement at the very top of your code module
this will force you to declare all variables and thus lead to some extra work, but you'll get repaid with much more control over your variables usage and misspelling, thus saving debugging time
dim variables to hold rows index as of Long type, to handle rows index higher then 32767
avoid inner loop using the Resize() method of range object
much like follows:
Option Explicit
Sub Makro1()
Dim i As Long, totalRows As Long, lastRow As Long, Number As Long
With ActiveSheet
'for looping
totalRows = .Cells(.Rows.Count, "A").End(xlUp).Row
'index of row to add from
lastRow = totalRows + 1 '<--| start pasting values one row below the last non empty one in column "A"
'data starts at row #3
For i = 3 To totalRows
If .Cells(i, 19).Value > 0 Then
Number = .Cells(i, 19).Value
.Rows(lastRow).Resize(Number).Value = .Rows(i).Value
lastRow = lastRow + Number
End If
Next i
End With
End Sub
I'm in the need of your help to solve the basic exercise I encountered during the course of learning Excel VBA. So, here it is:
There is a list of rollercoasters, where one column represents the name of the rollercoaster, whilst another column its type. I have to loop down the list, until the empty cell, selecting only those rollercoasters, the type of which is "Wooden". The sub should end with a message box displaying all rollercoasters' names, that matched our "Wooden" criterion (every line of msgbox contains one name).
So, anyone could advise a new learner how to cope with the above...?
This will run on the first 1000 rows where column a is the rollercoasters and column b is the type. you can cahnge the number 1000 to another number or xldown if you desire.
Sub Macro1()
'
Dim Rollers As String
For i = 1 To 1000
If Cells(i, 2) = "Wooden" Then Rollers = Rollers & vbNewLine & Cells(i, 1).Value
If Cells(i, 1) = "" Then MsgBox (Rollers): End
Next i
'
End Sub
I would add to Balinti's answer. This will get you the last row to use instead of hardcoding 1000
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
Then you would have a loop that looked like this
For i = 1 To LastRow
Next i
MsgBox Rollers
Is there a way to check if all cells in a column are less than 1? If there were only a few cells, with the number of cells known up front, I would use the code below.
However, from case to case the number of cells in column A will vary. I need to know if any of the cells in column A is less than 1.
If there is one (or more) cell containing a value less than 1, I need a cell (A1 for example) to show NOT OK. If only ALL the cells' values are greater than 1, I need the cell (A1 for example) to show OK.
If all cells in column A have values greater than 1, I want to continue and check column B for the same thing. Otherwise I want to save and close the workbook and continue with next open workbook...also with vba code.
Any suggestions on how to write this in VBA? Maybe there is way other than If(AND...)?
Sub IfAnd()
IF(AND(A5>1,A4>1,A3>1,A2>1),"OK", "NOT OK")
End Sub
This code will solve all your columns and insert the data in THE FIRST ROW OF EACH COLUMN
Sub Problems()
Dim CurCol, LastRow, LastCol as Long
LastCol = Cells(2, Columns.Count).End(xlToLeft).Column
For CurCol = 1 to LastCol
LastRow = Cells(Rows.Count, CurCol).End(xlUp).Row
If WorksheetFunction.Min(Range(Cells(2, CurCol), Cells(LastRow, CurCol))) < 1 Then
Cells(1, CurCol).Value = "NOT OK"
Else
Cells(1, CurCol).Value = "OK"
End If
Next CurCol
End Sub
Here is a way of doing it without any worksheet functions.
Sub test()
Dim ws As Worksheet
Dim ce As Range
Dim sr, lr, lc As Integer
'worksheet you are working with
Set ws = ThisWorkbook.Sheets(1)
'column you are searching
Set ce = ws.Cells(ws.Rows.Count, 1)
'start row set to 2 so row 1 will contain output
Let sr = 2
'search only the last row
Let lr = ce.End(xlUp).Row
Let lc = ws.Cells(sr, ws.Columns.Count).End(xlToLeft).Column
For c = 1 To lc
For r = sr To lr
If ws.Cells(r, c).Value < 1 Then
ws.Cells(1, c).Value = "NOT OK"
GoTo NotOK
End If
Next r
ws.Cells(1, c).Value = "OK"
NotOK:
Set ce = ws.Cells(ws.Rows.Count, c+1)
Let lr = ce.End(xlUp).Row
Next c
End Sub
This should be faster and more efficient for large data sets. Especially if it is sorted smallest to largest.
Here you are:
=IF(MAX(A:A)<1)
If VBA is not required, here is a worksheet formula that should do the job, and will also ignore blanks and non-numeric entries:
This formula must be array-entered:
=IF(ISNUMBER(MATCH(TRUE,IF(ISNUMBER($A:$A),$A:$A)<1,0)),"NOT OK","OK")
If this formula must be located in A1, change the range references from $A:$A to $A$2:$A$1000 where 1000 represents the highest conceivable row number for the data.
To array-enter a formula, after entering
the formula into the cell or formula bar, hold down
< ctrl-shift > while hitting < enter >. If you did this
correctly, Excel will place braces {...} around the formula.