I would like to set up the different formula for negative and positive values.
My code below suppose to be valid, but only the formula for negative values work.
Dim wks As Worksheet
Dim sunString As String
Dim rng3 As Range
sunString = "-"
Set wks = ThisWorkbook.ActiveSheet
Set rng3 = wks.Range("F2:F" & lRow)
With rng3
If InStr(sunString, "-") > 0 Then
Range("W2:W" & lRow).Formula = "=R2-U2-V2"
Else
Range("W2:W" & lRow).Formula = "=R2+U2+V2"
End If
The second formula (else statement) doesn't work at all.
What is wrong here?
Why not use a single formula that includes the condition and get rid of the unneeded looping?
Sub LoopRange()
Dim wks As Worksheet
Dim lRow As Long
Dim rng As Range
Set wks = ThisWorkbook.ActiveSheet
lRow = wks.Cells(wks.Rows.Count, "F").End(xlUp).Row
Set rng = wks.Range("W2:W" & lRow)
rng.Formula = "=IF(F2<0,R2-U2-V2 ,R2+U2+V2)"
End Sub
If the data in column F is not numeric you could use this formula to check for -.
rng.Formula = "=IF(LEFT(F2)=""-"",R2-U2-V2 ,R2+U2+V2)"
Related
In the code below, I have identified a range (ColRng) in which I want to check each cell - if it is empty, there is a SUMIFS function to perform. It does not work. I know my syntax and logic is horrid, but I can't figure out how to make it work.
Dim ColRng As Range
Dim LastCol As Long
Dim LastRowScenario As Long
Dim x As Long
Dim rngCrit1 As Range
Dim rngCrit2 As Range
Dim rngSum As Range
LastRowScenario = Sheets("Sheet1").Range("Q2").End(xlDown).Row
Set rngCrit1 = Sheets("Sheet1").Range("D2:D" & LastRowScenario)
Set rngCrit2 = Sheets("Sheet1").Range("B2:B" & LastRowScenario)
Set rngSum = Sheets("Sheet1").Range("Q2:Q" & LastRowScenario)
LastCol = Sheets("Summary").Range("B5").End(xlToRight).Column
Set ColRng = Range(LastCol & "6:" & LastCol & "149")
For x = ColRng.Cells.Count To 1 Step -1
With ColRng.Cells(x)
' If the cell is empty, perform a SUMIFS
If IsEmpty(.Value) Then
.Formula = Application.WorksheetFunction.SumIfs(rngSum, rngCrit1, .Range("E" & .Row).Value, rngCrit2, .Range("B" & .Row).Value)
End If
End With
Next x
Your ColRng construction is wrong - try something like this instead:
Dim ColRng As Range
Dim LastCol As Long
Dim LastRowScenario As Long
Dim x As Long
Dim rngCrit1 As Range
Dim rngCrit2 As Range
Dim rngSum As Range, ws As Worksheet, wsSumm As Worksheet
set ws = Sheets("Sheet1")
Set rngSum = ws.Range("Q2:Q" & ws.Range("Q2").End(xlDown).Row)
Set rngCrit1 = rngSum.EntireRow.Columns("D")
Set rngCrit2 = rngSum.EntireRow.Columns("B")
Set wsSumm = Sheets("Summary")
With wsSumm.Range("B5").End(xlToRight).EntireColumn
Set ColRng = wsSumm.Range(.Cells(6), .Cells(149))
End With
For x = ColRng.Cells.Count To 1 Step -1
With ColRng.Cells(x)
' If the cell is empty, perform a SUMIFS
If IsEmpty(.Value) Then
.Formula = Application.SumIfs(rngSum, _
rngCrit1, .EntireRow.columns("E").Value, _
rngCrit2, .EntireRow.columns("B").Value)
End If
End With
Next x
I have a column with 7000+ names. I want to make each name's length not excess to 5. Here is what I have tried which doesn't work
Sub del()
Dim myCell
Set myCell = ActiveCell
Dim count As Integer
count = Len(ActiveCell)
While count > 5
myCell = Left(myCell, Len(myCell) - 1)
myCell.Offset(1, 0).Select
Set myCell = ActiveCell
Wend
End Sub
No need for VBA. You can use a formula, =Left(A1,5), to get the first 5 characters of the cell. Simply autofill the formula down.
If you still want VBA then also you do not need to loop. See this example. For explanation see Convert an entire range to uppercase without looping through all the cells
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
Dim rng As Range
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set rng = .Range("A1:A" & lRow)
rng = Evaluate("index(left(" & rng.Address(External:=True) & ",5),)")
End With
End Sub
In the above code I am assuming that the data is in column A in Sheet1. Change as applicable.
In Action
I am needing to add a .mp3 to the end of each entry in two columns. I have the code below which works but I have to select each item in the column and it applies it to those cells.
But I would like to have a code that would automatically add the .mp3 to the end of any entry in column B and D.
Here is my current code:
Sub AppendToExistingOnRight()
Dim c as range
For each c in Selection
If c.value <> "" Then c.value = c.value & ".mp3”
Next
End Sub
Any assistance would be appreciate to help make this just a little more efficient.
A solution without looping. I am showing it for columnB. Feel free to adapt it for column D
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim rng As Range
Dim sAddr As String
Dim lRow As Long
'~~> Change sheet name as applicable
Set ws = Sheet1
With ws
'~~> Find last row in Col B
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
'~~> Construct your range
Set rng = Range("B1:B" & lRow)
sAddr = rng.Address
'~~> Append ".mp3" to the entire range in 1 go
rng = Evaluate("index(concatenate(" & sAddr & ","".mp3""),)")
End With
End Sub
In Action
If you would like to understand how this works then you may want to see Convert an entire range to uppercase without looping through all the cells
I've added references to the workbook, worksheet, and set ranges which are then looped. I've also added a check to verify if ".mp3" already exists at the end of the cell. Finally, I prevented the screen from updating until the script has completed.
If you want it to run faster, specify the range (ie. ws.Range("B1:B1000") will check 1000 cells rather than 1048576).
Sub AppendToExistingOnRight()
Application.ScreenUpdating = False
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.ActiveSheet
Dim c As Range
Dim colB As Range: Set colB = ws.Range("B:B")
Dim colD As Range: Set colD = ws.Range("D:D")
For Each c In colB
If c.Value <> "" And Right(c.Value, 4) <> ".mp3" Then c.Value = c.Value & ".mp3"
Next
For Each c In colD
If c.Value <> "" Then c.Value = c.Value & ".mp3"
Next
Application.ScreenUpdating = True
End Sub
Try below sub. If your data is same in Column B and Column D then you can use one loop.
Sub AddMP3()
Dim bRng As Range, dRng As Range, mRng As Range
Set bRng = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
Set dRng = Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row)
For Each mRng In bRng
mRng = mRng & ".mp3"
Next
For Each mRng In dRng
mRng = mRng & ".mp3"
Next
Set bRng = Nothing
Set dRng = Nothing
End Sub
I am using this line to find the end of a dynamic range starting in B9:
Sheets("Summary").Range("B9", Sheets("Summary").Range("B" & Rows.Count).End(xlUp))
The range may anywhere from 2 rows long to 20 rows long but I need to set a limit to the range at 21 rows.
How do I do this?
Thanks
Find the last row and check if it is greater then 21. If it is, then set the last row as 21. See this. Also it is advisable to work with objects and variables. Code becomes easier to handle :)
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
Dim rng As Range
Dim lRowLimit As Long
Set ws = ThisWorkbook.Sheets("Summary")
'~~> Set the limit here
lRowLimit = 21
With ws
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
If lRow > lRowLimit Then lRow = lRowLimit
Set rng = .Range("B9:B" & lRow)
Debug.Print rng.Address
End With
End Sub
The range may anywhere from 2 rows long
Note: In such a case you want .Range("B9:B" & lRow) to be .Range("B1:B" & lRow)?
You need to count the rows in the same worksheet as you set the range. Therefore:-
Set Rng = Sheets("Summary").Range("B9", Sheets("Summary").Range("B" & Sheets("Summary").Rows.Count).End(xlUp))
But if you want to limit the end row you should determine a row number, like this.
Dim Rng As Range
Dim Rl As Long ' last row
With Sheets("Summary")
Rl = WorksheetFunction.Min(.Range("B" & .Rows.Count).End(xlUp).Row, 21)
Set Rng = Range(.Range("B9"), .Cells(Rl, "B"))
End With
Also
Sub Test()
Const MaxRow = 29
Dim MyRange As Range
With Sheets("Summary")
Set MyRange = .Range("B9", "B" & IIf(.Range("B" & Rows.Count).End(xlUp).Row > MaxRow, MaxRow, _
.Range("B" & Rows.Count).End(xlUp).Row))
End With
End Sub
I am trying to populate a range of cells dynamically using VLookup. My Active Sheet is where I am trying to insert value of cells from another worksheet in same workbook. For the second parameter of VLookup I am trying to use the variable dataRng which gets me the entire range of values to lookup in my source sheet (srcSheet). All the code works as expected except the VLookup returns #NAME? and its the dataRng variable which seems to be the issue. Any suggestions?
Sub VlookUpCreateDate()
Dim srcSheetName As String
Dim currSheetName As String
Dim currlastRow As Long
Dim currlastCol As Long
Dim srcLastRow As Long
Dim srcLastCol As Long
Dim srcFirstRow As Long
Dim srcSheet As Worksheet
Dim firstVar As String
Dim refRng As Range, ref As Range, dataRng As Range
srcSheetName = ActiveWorkbook.Worksheets(1).Name
Set srcSheet = ActiveWorkbook.Sheets(srcSheetName)
'Get Last Row and Column
With ActiveSheet
currlastRow = ActiveSheet.UsedRange.Rows.Count
currlastCol = ActiveSheet.UsedRange.Columns.Count
End With
With srcSheet
srcFirstRow = 2
srcLastRow = srcSheet.UsedRange.Rows.Count
srcLastCol = srcSheet.UsedRange.Columns.Count
End With
Set dataRng = srcSheet.Range(srcSheet.Cells(srcFirstRow, srcLastCol), srcSheet.Cells(srcLastRow, srcLastCol))
For i = 2 To currlastRow
Cells(i, currlastCol + 1).Select
ConvertToLetter & "$" & srcLastRow
ActiveCell.Formula = "=VLOOKUP(A2,dataRng,4,False)"
Next i
End Sub
Here is a simple example that should work for you, using the dataRng address in the formula
Dim dataRng As Range, s
Set dataRng = Range("AA1:AF7")
s = dataRng.Address
ActiveCell = "=VLOOKUP(A2," & s & ",4,0)"