I am trying to create an allocation system, and whilst I've programmed VBA before I'm stuck this time!
I have data across five columns, the contents of which determine which staff member I allocate to them.
What I need to do is this:
If column E = "a", then put name "xx" in column A (of same row)
If column E = "b", then put name "yy" in column A (of same row)
If column E is blank, then move to next criteria....
If column D is "c" then put name "zz" in column A (of same row)
If column D is "d" then move to next criteria....
If column A is blank then put name "ww" in column A.
Thanks in advance!!
Sub Allocate()
Dim i As Long
For i = 1 To Range("E" & Rows.Count).End(xlUp).Row
If Range("E" & i) = "a" Then
Range("A" & i) = "xx"
ElseIf Range("E" & i) = "b" Then
Range("A" & i) = "yy"
End If
If Range("D" & i) = "c" Then
Range("A" & i) = "zz"
End If
If IsEmpty(Range("A" & i)) Then
Range("A" & i) = "ww"
End If
Next i
End Sub
Note that
If column E is blank, then move to next criteria....
isn't included anywhere in the code, there is no point to implement this in the code because it literally does nothing :)
Like I mentioned in the link under your question, you don't need loop for this.
If you were to use an Excel formula then you would use something like this
=IF(E1="a","xx",IF(E1="b","yy",IF(D1="c","zz","ww")))
Simply use that in the vba code
Option Explicit
Sub Sample()
Dim lRow As Long
'~~> Change this to the relevant sheet
With ThisWorkbook.Sheets("Sheet1")
lRow = .Range("E" & .Rows.Count).End(xlUp).Row
.Range("A1:A" & lRow).Formula = "=IF(E1=""a"",""xx"",IF(E1=""b"",""yy"",IF(D1=""c"",""zz"",""ww"")))"
.Range("A1:A" & lRow).Value = .Range("A1:A" & lRow).Value
End With
End Sub
ScreenShot:
Related
any help with this would be appreciated.
I am trying to copy a cell from column (G) into another worksheet, if cells from the same row in column (R) = "Y" and column (B) = "Month"
I had it working for just "Y" criteria but as soon as I added the "Month" this button has stopped working?
this is the code I have;
Private Sub CommandButton1_Click()
Dim LR As Long, i As Long
With Sheets("Savings Q4")
LR = .Range("R" & Rows.Count).End(xlUp).Row
For i = 1 To LR
With .Range("R" & i)
If .Value = "Y" Then
With .Range("B" & i)
If .Value = "January" Then
Sheets("Savings Q4").Range("G:G").Copy Destination:=Sheets("Cifas Loadings").Range("A:A")
End If
End With
Next i
End With
End Sub
Any help would be appreciated.
Thanks
Too Much 'Withing' and 'Ifing'
Rules
The number of With statements must be equal to the number of End With statements.
The number of If statements must be equal to the number of End If statements, except when there is a 'one-line' If Statement.
Insights
Alexey C's solution gets those With-s and If-s in line, but problems still remain.
When you write With .Range("R" & i) it refers to Sheets("Savings Q4") from the previous With statement and you are actually shortening the line
With Sheets("Savings Q4").Range("R" & i)
which is OK.
When you later write With .Range("B" & i) it doesn't refer to Sheets("Savings Q4"), it refers to .Range("R" & i) i.e. your not shortening the line With Sheets("Savings Q4").Range("B" & i) but
With Sheets("Savings Q4").Range("R" & i).Range("B" & i)
which is WRONG.
Matteo NNZ correctly commented that the If statements could be shortened to one If statement using the And operator.
When you write
Sheets("Savings Q4").Range("G:G").Copy_
Destination:=Sheets("Cifas Loadings").Range("A:A")
you are copying the entire G column to the entire A column. Since this is in a loop (For i = 1 to LR), each time the code 'encounters' "January" and "Yes", it copies the entire column. It is highly unlikely that you are trying to achieve that functionality.
Plan of Changes
Get rid of the 'inner' With's.
Reduce the If's using And.
Change the COLUMN ranges G:G and A:A to the corresponding CELL ranges.
Get rid of Destination:=.
The Code
Sub WithIf()
Dim LR As Long, i As Long
With Sheets("Savings Q4")
LR = .Range("R" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If .Range("R" & i).Value = "Y" And _
.Range("B" & i).Value = "January" Then
.Range("G" & i).Copy Sheets("Cifas Loadings").Range("A" & i)
End If
Next i
End With
End Sub
Remaining Issues
A further problem might be that you didn't want the A column data copied in the same row as the G column data. If this is the case you should apply the same LR = .Range("R" & Rows.Count).End(xlUp).Row logic and integrate it into the code referring to the A column of sheet "Cifas Loadings".
At least, you forgot one End With and one End If. But anyway it's not correct with logical part.
Dim LR As Long, i As Long
With Sheets("Savings Q4")
LR = .Range("R" & Rows.count).End(xlUp).Row
For i = 1 To LR
With .Range("R" & i)
If .Value = "Y" Then
With .Range("B" & i)
If .Value = "January" Then
Sheets("Savings Q4").Range("G:G").Copy Destination:=Sheets("Cifas Loadings").Range("A:A")
End If
End With
End If
End With
Next i
End With
It's easier to make it w/o With, like
if Range("R"& i).value="Y" and Range("B" & i).value = "Month"
COPE CELLS
end if
I am trying to replicate in VBA the simple function in excel which allows you to repeat a function through an entire column, and stops when the columns on the side are empty. Specifically, I want to repeat an if - else if function for the entire relevant part of the column
Here's an attempt which does not really work
Sub RepeatIfElseif
Range("A1").Select
If selection > 0 Then
Range("B1").Select
ActiveCell.FormulaR1C1 = "X"
Range("A1").Select
ElseIf selection <= 0 Then
Range("B1").Select
ActiveCell.FormulaR1C1 = "Y"
End If
Range("B1").Select
selection.AutoFill Destination:=Range("B1:B134")
Is there any way I can do it with a loop?
You do not need to loop to drop formulas in. You just need to know where the last row is!
Pick a column that is most likely to represent your last row (I am using Column A in my example) and then you can dynamically drop-down your equation in one line without the loop.
The below will fill in the equation A2 + 1 in Column B starting from 2nd row (assuming you have a header row) down to the last used row in Column A
Option Explicit
Sub Formula_Spill()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<-- Update sheet!
Dim LR As Long
LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row '<-- Update column!
ws.Range("B2:B" & LR).Formula = "=A2+1" '<-- Update formula!
End Sub
If you want to use a loop, you can use something like the code below:
For i = 1 To 134
If Range("A" & i).Value > 0 Then
Range("B" & i).FormulaR1C1 = "X"
Else
Range("B" & i").FormulaR1C1 = "Y"
End If
Next I
It can be done without a loop, something like:
Range("B1:B134").Formula = "=IF(A1>0," & Chr(34) & "X" & Chr(34) & "," & Chr(34) & "Y" & Chr(34) & ")"
Not sure what formula you are trying to achieve with .FormulaR1C1 = "Y" ?
I'm trying to improve my English, I swear...
I would do something like this:
dim row as long
dim last_row as Long
last_row = ActiveSheet.Range("A1048576").End(xlUp).Row
For row = 1 to last_row
If Range("A" & row).Value > 0 Then
ActiveSheet.Range("B" & row).Value = "X"
Else
ActiveSheet.Range("B" & row).Value = "Y"
End If
Next row
Hope this helps.
I'm having an issue with trying to expand on the code that I have written. The code I have pasted below is currently working as intended. The issue I have is that I am trying to make the "P2" cell variable. Essentially, I am trying to compare the ("K" & i) cell in the loop to all the dates in the range P2 to AA2 on my sheet. Then if the month and year matches, paste the data in the corresponding column that matched. I have tried replacing the column reference P with another integer, but could not get the nested loop to function correctly. Is there a different way to establish a column as a variable? Thank you for your help.
Sub Test()
Dim i As Integer
Sheets("Sheet1").Select
For i = 3 To 6
If Month(Range("K" & i)) = Month(Range("P2")) And Year(Range("K" & i)) = Year(Range("P2")) And Range("J" & i).Value > "0" Then
Range("J" & i).Copy
Range("P" & i).PasteSpecial xlPasteValues
End If
Next i
End Sub
Just loop through the columns 16 through 27 inside your existing loop:
Sub Test()
Dim i As Integer
Sheets("Sheet1").Select
For i = 3 To 6
'loop columns p through aa
For k = 16 to 27
'Instead of Range() we are using Cell() to refer to the column variabl-y... Cells(<rownum>,<columnnum>)
If Month(Range("K" & i)) = Month(Cells(2,k)) And Year(Range("K" & i)) = Year(Cells(2,k)) And Range("J" & i).Value > "0" Then
Range("J" & i).Copy
Cells(i,k).PasteSpecial xlPasteValues
End If
Next k
Next i
End Sub
I have a spreadsheet that I need to sum how many values "UDL" there is in column(N:N), but the problem is they should only be counted for every unique number in column (C.C)
So for every number that also has "UDL" in column N they should only be counted once as there can be a lot of duplicates.
Hope you can help :)
Seems like a loop & delimited string would be a quick way to get what you're wanting. Assuming Column A is always filled & has a header in row 1, something like:
Dim u as string
Dim i as long
dim t as long
i = 2
Do While Range("A" & i).value <> ""
If Range("N" & i).value = "UDL" Then
If InStr(1, u, "|" & Range("C" & i).value & "|") = 0 Then
t = t + 1
u = u & "|" & Range("C" & i).value & "|"
End If 'else the value in C is non-unique
End If 'else not UDL so no action needed
i = i + 1
Loop
Range("A" & i + 1).value = t 'Outputs t to column A with a blank row between it & your data
That'll need some adjusting based on what column should control the loop, what row the loop should start on, and where you want the count to go.
I have an Excel Macro as follows:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim i&, j&, k&, LR_A&, LR_B&, LR_C&, count&
LR_A = Range("A" & Rows.count).End(xlUp).Row
LR_B = Range("B" & Rows.count).End(xlUp).Row
LR_C = Range("C" & Rows.count).End(xlUp).Row
count = 1
For i = 1 To LR_A
For j = 1 To LR_B
For k = 1 To LR_C
Range("D" & count).Value = Range("A" & i).Value
Range("E" & count).Value = Range("B" & j).Value
Range("F" & count).Value = Range("C" & k).Value
count = count + 1
Next k
Next j
Next i
Application.ScreenUpdating = True
End Sub
As you can see, it is resorting the data in columns A, B, and C into D, E, and F.
What code do I need to add to get it to ignore the column headers in A, B, and C? I have searched around but have been unable to find an answer.
In addition, how would I change it so that it instead of resorting the data into D, E, and F, it is resorting it into A, B, and C on another worksheet?
This is my first macro, so they are pretty basic questions.
Thanks in advance
Answer to your question
To avoid copying the headers, you should begin your loops at index 2.
To copy values to another Worksheet, you need to call it in your Range.
For i = 2 To LR_A
For j = 2 To LR_B
For k = 2 To LR_C
Sheets("My other ws").Range("D" & count).Value = Range("A" & i).Value
Sheets("My other ws").Range("E" & count).Value = Range("B" & j).Value
Sheets("My other ws").Range("F" & count).Value = Range("C" & k).Value
count = count + 1
Next k
Next j
Next i
Maybe a better way to handle this case
Looping over range using index can be very slow.
I advise you to have a look at this link: http://www.ozgrid.com/VBA/VBALoops.htm where the author explained faster ways to loop over ranges.
Some tips
Have a look at Excel SpecialCells as described here.
For instance, in your case, you could try to use ActiveSheet.UsedRange instead of finding the last used row.