I have a column that has many blanks and entries. I want to take the entries (ignoring the blanks) and move them over to the right once and down twice replacing the contents. I have a feeling you would use the offset function, however I don't know how to write this in VBA. I've only used offset as a formula. Any help would be appreciated...
here's a one liner:
Range("A:A").SpecialCells(xlCellTypeConstants).Offset(2, 1).FormulaR1C1 = "=R[-2]C[-1]" '<--| change "A:A" to actual column index
or, should your "not blank" cells derive from formulas in the cells:
Range("A:A").SpecialCells(xlCellTypeFormulas).Offset(2, 1).FormulaR1C1 = "=R[-2]C[-1]"
First you need to create a loop, that moves through all the values of your range. There many ways to create loops, but here is one example:
'find last row of range
lastrow = ActiveSheet.UsedRange.Rows.Count
'Loops through the values from 2 to the last row of range
For x=2 to lastrow
Next x
Then I recommend to loop through the range and check each cell value for your criteria using the IF function:
'Checks for blank value in column A. If not blank
If Cells(x, 1).Value <> "" then
'Do Something
End IF
Now in order to copy all values in a new range, just set the values of the old and new cell equal:
'Moves value from column A to column B and two cells down
Cells(x+2, 2).Value = Cells(x, 1).Value
In summary your code would look something like this:
Sub MoveValue ()
lastrow = ActiveSheet.UsedRange.Rows.Count
For x=2 to lastrow
If Cells(x, 1).Value <> "" then
Cells(x+2, 2).Value = Cells(x, 1).Value
End IF
Next x
End Sub
Related
I am trying to create a spreadsheet whereby I have a value in a cell in a worksheet called "Equipment" cell C5, for example a Value of 4.
Starting Cell Image
I need to use this value to copy a section of the same row (D5:M5) and paste it that many times into a worksheet called "Programming" also if this changes I would like it to delete or add where required, ignoring where there is a blank or 0 value in the "equipment" sheet
Desired Result
I have around 30 different items and all will have different sections to copy but they will be of the same size. Also Could this look down a list of values all in the same column and do the same for all the values
I'm very new to VBA and have managed to hide and show tabs based on values but i'm struggling to get my head around this as it's a little too complicated at this point.
Thank You in advance
Lee
This is what I have so far, I have edited the code to what I believe is correct but it still isn't working
Sub copySheetCells()
'loop by each cell in column "C"
For i = 2 To Sheets("Equipment").Cells(Rows.Count, "C").End(xlUp).Row
'repeat copy x times (based on cell in column "C" value)
For j = 0 To (Sheets("Equipment").Cells(i, "C").Value - 1)
'define source range
Source = "D" & (i) & ":M" & (i)
'find last row on second sheet
lastRowS2 = Sheets("Hardware_Programming").Cells(Rows.Count, "A").End(xlUp).Row
'copy data
Sheets("Equipment").Range(Source).copy Destination:=Sheets("Hardware_Programming").Range("A" & lastRowS2 + 1)
Next j
Next i
'copy headers
Sheets("Equipment").Range("D1:M1").copy Destination:=Sheets ("Hardware_Programming").Range("A1:J1")
End Sub
I only get blank spaces, is anyone able to advise any further?
Here you go, use this macro. Based on names Programming and Equipment as originally requested.
Sub copySheetCells()
'loop by each cell in column "C"
For i = 2 To Sheets("Programming").Cells(Rows.Count, "C").End(xlUp).Row
'repeat copy x times (based on cell in column "C" value)
For j = 0 To (Sheets("Programming").Cells(i, "C").Value - 1)
'define source range
Source = "D" & (i) & ":M" & (i)
'find last row on second sheet
lastRowS2 = Sheets("Equipment").Cells(Rows.Count, "A").End(xlUp).Row
'copy data
Sheets("Programming").Range(Source).copy Destination:=Sheets("Equipment").Range("A" & lastRowS2 + 1)
Next j
Next i
'copy headers
Sheets("Programming").Range("D1:M1").copy Destination:=Sheets("Equipment").Range("A1:J1")
End Sub
EDIT
Please avoid copying the code from the answer and posting it back at your question, I replaced the Sheet1 with Programming so you can rename that sheet in your workbook.
Macro seems to do what it does, the quantity in Sheet1/Programming was not provided (column "C" according to your initial requirements):
Source (with added quantity)
Result:
Hope this will solve your problem :)
For i = 1 To 30 Step 1
If Sheets("Equipment").Cells(1 + 4, 3).Value > 0 Then
Sheet1.Range(Cells(i + 3, 5), Cells(i + 3, 13)).Copy
For j = 1 To Sheet1.Cells(1 + 4, 3).Value Step 1
LR = Sheets("Programming").Cells(Sheets("Programming").Rows.Count, "A").End(xlUp).Row
Sheets("Programming").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues
Next
End If
Next
Cheers ;)
I'm new to VBA and struggling with the piece of code.
I need to find the first non-empty row where the conditions are simultaneously met. There must be text in col B and C and number in col D and G (all 4 conditions must be met).
I'd very grateful for help
s
write like below code using and if & and note:lastrow is end of column values.
for i = 1 to lastrow
if cells(i,"b")<>"" and cells(i,"c")<>"" and isnumber(cells(i,"d"))= true and isnumber(cells(i,"g"))= true then
'do something
end if
next i
you may want to nest SpecialCells() method as follows:
Sub main()
With Worksheets("Conditions") '<--| change "Conditions" to your actual worksheet name
With .Range("B1", .Cells(.Rows.Count, "B").End(xlUp)) '<-- refer to column "B" cells down to last non empty one
With .SpecialCells(XlCellType.xlCellTypeConstants, xlTextValues) '<-- refer to its "text" cells only
With .Offset(, 1).SpecialCells(XlCellType.xlCellTypeConstants, xlTextValues) '<-- refer to adjacent column "text" cells only
With .Offset(, 1).SpecialCells(XlCellType.xlCellTypeConstants, xlNumbers) '<-- refer to adjacent column "number" cells only
With .Offset(, 1).SpecialCells(XlCellType.xlCellTypeConstants, xlNumbers) '<-- refer to adjacent column "number" cells only
MsgBox .Cells(1, 1).row '<--| get first "multifiltered" cells row
End With
End With
End With
End With
End With
End With
End Sub
you may need to add test before each SpecialCells() to check that "current" column actually has some text/numbers value, using a mix of Count() and CountA() method
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.
Below I am attempting to place the formula just to the right of the last column, beginning at row 2. I know the For statement works, as well as the searching for last column/ row as i've used this in a previous macro when placing a formula down a column. The only question I have is how do I make the VLookup formula work properly?
End goal:
1) Forumla on column to the right of last one
2) Vlookup looksup the value in the last column on the given row within the For statement on a tab called "Lookup"
3) On this Lookup tab, column A is where the value will be found, but I need to return the second column value.
Please zero in on the forumula beginning with the "=iferror(...". I currently receive the error, "Application Defined or Object-Defined" error.
EThree = Cells(Rows.Count, 4).End(xlUp).Row
NumThree = Evaluate("=COUNTA(9:9)")
For r = 2 To EThree
Cells(r, NumThree + 2).Formula = "=IFERROR(((Vlookup(" & Cells(r, 14).Value & ",Lookup!$A:$B,2,0)""))))"
Next
You can place your formula in one go; no need to loop.
Try this:
With Sheets("NameOfWorksheet") '~~> change to suit
'~~> first get the last row and column
Dim lrow As Long, lcol As Long
lrow = .Range("D" & .Rows.Count).End(xlUp).Row
lcol = .Cells(9, .Columns.Count).End(xlToLeft).Column
Dim rngToFillFormula As Range, mylookup As String
'~~> get the lookup value address
mylookup = .Cells(2, lcol).Address(False, False, xlA1)
'~~> set the range you need to fill your formula
Set rngToFillFormula = .Range(.Cells(2, lcol), Cells(lrow, lcol)).Offset(0, 1)
rngToFillFormula.Formula = "=IFERROR(VLOOKUP(" & mylookup & _
",Lookup!A:B,2,0),"""")"
End With
What we did is explained in the comments. HTH.
So, I'm trying to figure out how to write an Excel macro to populate Column C with either 3 or a 4 depending on the amount of numbers contained in Column B.
I have searched up and down for the right wording to this, but I keep coming up short.
Basically, I need the macro to look at the number of digits in Column B. If there are 12 digits then the number is a UPC, and if there are 13 then the number is an EAN. I then need the macro to populate Column C with a 3 for UPCs and a 4 for EANs. This needs to be for the entire range of rows in the spreadsheet.
Does anyone have any ideas? Thanks a lot in advance!
You don't need to use a dirty old loop, try this (much faster if you have lots of rows):
Sub HTH()
With Sheet1.Range("B1", Cells(Rows.Count, "B").End(xlUp)).Offset(, 1)
.Formula = "=IF(LEN(TRIM(B1))=12,3,IF(LEN(TRIM(B1))=13,4,""""))"
.Value = .Value
End With
End Sub
Or use a user defined function, which has the advantage of changing when the data in column B is updated.
Better yet just use a formula, you don't really need VBA.
Alternative VBA Method (looping the fast way):
Sub HTH()
Dim vArray As Variant
Dim lCnt As Long
With Range("B1", Cells(Rows.Count, "B").End(xlUp))
vArray = .Value
For lCnt = 1 To UBound(vArray, 1)
Select Case Len(Trim(vArray(lCnt, 1)))
Case 12: vArray(lCnt, 1) = 3
Case 13: vArray(lCnt, 1) = 4
Case Else:
End Select
Next lCnt
.Offset(, 1).Value = vArray
End With
End Sub
You can get the length of a cell's value by using Len() like this Len(Range("A1")) for example.
Now you just need to loop through your column and look at each value. If you look for the last used cell and loop only through that range your loop will be faster.
Here is how I would do it:
sub TestUPC()
With ActiveSheet
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
Dim rRng As Range
Set rRng = Range("B1:B" & LastRow)
For Each cell In rRng.Cells
If Len(Trim(cell))=12 then
cell.Offset(0, 1).Value = 3
ElseIf Len(Trim(cell))=13 then
cell.Offset(0, 1).Value = 4
End If
Next
End Sub
An in cell equation could look like this:
=IF(LEN(B1)=12,3,IF(LEN(B1)=13,4," "))
As suggested in the comments you might want to test for spaces depending on your data:
=IF(LEN(TRIM(A1))=12,3,IF(LEN(TRIM(A1))=13,4," "))