Would like to include a value to all my cells in column G if there are blank in column K, else no change.
If ActiveSheet.Range("K").Value, Criteria1:=" = " Then ActiveSheet.Range("G").Value = "Promo"
Else
Exit Sub
In order to test all the values you need to loop through the column. My example assumes the data doesn't have more than 100'000 lines and that you were testing for " = " to be included... addapt as needed.
Sub TestColumnK()
For i = 1 To ActiveSheet.Range("K100000").End(xlUp).Row
If InStr(1, ActiveSheet.Range("K" & i).Value, "=") > 0 Then
ActiveSheet.Range("G" & i).Value = "Promo"
End If
Next i
End Sub
Related
I have this code below which I want to be used in a loop. However, instead of C5 and D5, I would want this loop to be run on all the cells in column C and column D and not only for C5 and D5.
To summarize, I would want C5 and D5 to be replaced by every cell in Column C and D. Please assist.
For i = 1 To 5
Valuex = Evaluate("=IsNumber(Value(Mid(C5, 2, 1)))")
MsgBox (Valuex)
Valuex1 = Evaluate("=Left(Trim(C5), 1) = ""R""")
MsgBox (Valuex1)
If ((Evaluate("=Left(Trim(C5), 1) = ""R""") = "True") And (Evaluate("=IsNumber(Value(Mid(C5, 2, 1)))") = "True")) Then
Range("D5").Formula = "=VLOOKUP(C5,[old.xls]Sheet1!$D:$V,19,0)"
MsgBox ("if")
Else
Range("D5").Formula = "=VLOOKUP(C5,[old.xls]Sheet1!$E:$V,18,0)"
MsgBox ("else")
End If
Next i
Think this does what you want. It will run from row 1 to the last row in C. Note that you could do all this without VBA.
Sub x()
Dim i As Long, Valuex As Boolean, Valuex1 As Boolean
For i = 1 To Range("C" & Rows.Count).End(xlUp).Row
Valuex = Evaluate("=IsNumber(Value(Mid(C" & i & ", 2, 1)))")
MsgBox (Valuex)
Valuex1 = Evaluate("=Left(Trim(C" & i & "), 1) = ""R""")
MsgBox (Valuex1)
If Valuex1 And Valuex Then
Range("D" & i).Formula = "=VLOOKUP(C" & i & ",[old.xls]Sheet1!$D:$V,19,0)"
MsgBox ("if")
Else
Range("D" & i).Formula = "=VLOOKUP(C" & i & ",[old.xls]Sheet1!$E:$V,18,0)"
MsgBox ("else")
End If
Next i
End Sub
I think you can avoid the loop altogether thus
Sub xx()
Dim i As Long
i = Range("C" & Rows.Count).End(xlUp).Row
With Range("D1:D" & i)
.Formula = "=IF(AND(ISNUMBER(VALUE(MID(C1, 2, 1))),LEFT(TRIM(C1), 1) = ""R""),VLOOKUP(C1,Sheet1!$D:$V,19,0),VLOOKUP(C1,Sheet1!$E:$V,18,0))"
.Value = .Value
End With
End Sub
This code is a part of bigger code that takes words from a listbox and places into another listbox, which with this code separates the words in the listbox and establishes into words that are able to be inserted into a cell, for some reason second strsplt is not showing, everything else is working very well, it's just this one, I need help with and there is no error that is thrown out. I've looked it over with F8 and breakpoints and the problem seems to be with
If ii < .ColumnCount - 1 Then
str = str & .List(i, ii) & vbCrLf
Else
str = str & .List(i, ii)
End If
The Whole Code:
With Me.selecteditems
ThisWorkbook.Sheets(9).Range("A:B").ClearContents
For i = 0 To .ListCount - 1
If .Selected(i) Then
found = True
For ii = 0 To .ColumnCount - 1
ReDim strsplt(0 To i)
If str = "" Then
str = .List(i, ii) & vbCrLf
Else
If ii < .ColumnCount - 1 Then
str = str & .List(i, ii) & vbCrLf
Else
str = str & .List(i, ii)
End If
End If
Next ii
message = "How much" & vbCrLf & str & "?" & vbCrLf
title = "Amount"
defaultval = "1"
quantity = InputBox(message, title, defaultval)
strsplt = Split(str, "*")
End If
'On Error Resume Next
With ThisWorkbook.Sheets(9)
.Range("A" & (i + 1)).Value = strsplt(i)
.Range("B" & (i + 1)).Value = quantity
End With
'On Error GoTo 0
Next i
End With
EDIT: The way it looks like using debug.print str
item1
item2 item3 item4 ...
Try a bit brute forcing like this:
If ii < .ColumnCount - 1 Then
str = str & .List(i+1, ii) & vbCrLf
Else
str = str & .List(i+1, ii)
End If
I have changed i to i+1 in your code.
Then debug again. If it does not work, try i-1, ii+1, ii-1. One of these will work and it may give an out of range error. Then fix the array length and have fun.
I got the error related to the code below. The weird part is, I am able to access and write to the cells.formula property just find in immediate, and I was able to run the formula just fine as well in immediate. The error is "Application-defined or object-defined error". Since I have no clue what is causing the issue, I pasted the entire code here to see if anyone see something that may be causing it. It's weird....
' This function adds a column to an existing table if the table does not already has the function, or updates the table with the new values as needed
Public Function AddAssocStds(objSheet As Worksheet) As Boolean
Dim i As Integer
Dim rowHeader As Integer
Dim CombDes As Integer
Dim AssocStd As Integer
Dim SAP As Variant
Dim Stockcode As Variant
Dim Mincom As Variant
Dim WriteAssocStd As String
' Defines my header row
rowHeader = 1
' A specific row to look up in an existing table
CombDes = -1
' This is the write row
AssocStd = -1
i = 1
' Speeding up the run, speed play
Application.ScreenUpdating = False
' Registers the columns in the sheet correctly first
For i = 1 To objSheet.Cells(rowHeader, objSheet.Columns.Count).End(xlToLeft).Column
Select Case Cells(rowHeader, i).value
Case "CombinedDescription"
CombDes = i
Case "AssocStds"
AssocStd = i
Case "SAP"
SAP = objSheet.Range(objSheet.Cells(rowHeader + 1, i), objSheet.Cells(objSheet.UsedRange.Count, i)).value
Case "Stockcode"
Stockcode = objSheet.Range(objSheet.Cells(rowHeader + 1, i), objSheet.Cells(objSheet.UsedRange.Count, i)).value
Case "Mincom"
Mincom = objSheet.Range(objSheet.Cells(rowHeader + 1, i), objSheet.Cells(objSheet.UsedRange.Count, i)).value
End Select
Next
' Determines which column to write to - either inserts after combdes column or make a new column
If AssocStd = -1 Then
If CombDes = -1 Then
AssocStd = objSheet.Cells(rowHeader, objSheet.Columns.Count).End(xlToLeft).Column + 1
Else
objSheet.Range(Cells(1, CombDes + 1), Cells(1, CombDes + 1)).EntireColumn.Insert
AssocStd = CombDes + 1
End If
End If
' Writes the header for the new column
objSheet.Cells(rowHeader, AssocStd).value = "AssocStds"
' Resets the counter
i = 1
' Loops throught the entire column
For i = 1 To objSheet.UsedRange.Count - rowHeader
If NotNull(CStr(SAP(i, 1))) Then
WriteAssocStd = AssocStdsGen(CStr(SAP(i, 1)))
Else
WriteAssocStd = "-1"
End If
If WriteAssocStd = "-1" And NotNull(CStr(Stockcode(i, 1))) Then
WriteAssocStd = AssocStdsGen(CStr(Stockcode(i, 1)))
Else
WriteAssocStd = "-1"
End If
If WriteAssocStd = "-1" And NotNull(CStr(Mincom(i, 1))) Then
WriteAssocStd = AssocStdsGen(CStr(Mincom(i, 1)))
Else
WriteAssocStd = "-1"
End If
' This is where the problem happens, when writing as a formula, it doesn't work...
If WriteAssocStd = "-1" Then
objSheet.Cells(i + rowHeader, AssocStd).Formula = "=IF(UPPER([#Standard RR]) <> " & Chr(34) & "NON-STD" & Chr(34) & ", [#Standard RR] &" & Chr(34) & "-" & Chr(34) & "&[#PlanNo] & " & Chr(34) & "." & Chr(34) & "& TEXT([#SheetNo], " & Chr(34) & "00" & Chr(34) & "), [#Standard RR])"
Else
objSheet.Cells(i + rowHeader, AssocStd).value = WriteAssocStd
End If
Next
AddAssocStds = True
Application.ScreenUpdating = True
End Function
Additional note:
The formula does work in excel by itself as evidenced by the rows that did not prompt the error
The error seems to only occur at the last row. I have a weird feeing it may be related
Sub sumtotal_of_month()
Dim a As Integer
a = 0
For i = 2 To 365
If (Sheets("Sheet1").Range("F" & i).Value = 1 And Sheets("Sheet1").Range("D" & i).Value <> "") Then
a = a + Sheets("Sheet1").Range("D" & i).Value
End If
Next i
MsgBox (a)
End Sub
Code above works fine, but when I try to substitute "1" with parameter month, it doesn't provide any output. This code is very amateur, because I am just a beginner. I use Excel 2007.
Sub sumtotal_of_month(month As Integer)
Dim a As Integer
a = 0
For i = 2 To 365
If (Sheets("Sheet1").Range("F" & i).Value = month And Sheets("Sheet1").Range("D" & i).Value <> "") Then
a = a + Sheets("Sheet1").Range("D" & i).Value
End If
Next i
MsgBox (a)
End Sub
given you have to check what value you are passing as month parameter to your sub, you can simplify your sub as follows:
Sub sumtotal_of_month(month As Integer)
Dim a As Double
With Worksheets("Sheet1")
a = WorksheetFunction.SumIf(.Range("F2:F365"), month, .Range("D2:D365"))
End With
MsgBox a
End Sub
I'm having some trouble understanding some strange behavior. The .address property of the range class is returning a cell in "Cell:Cell" format. Both (1) and (2) give the address in the form of "$A$1:$A$1" instead of simply "$A$1". A snippet of code is listed below:
With Sheet1
Set r = .Range("MyRange")
'(1)*
Debug.Print r.Address
r.Formula = "= 1 + 1"
For i = 1 To 47
Set r = r.Offset(0, 1)
'above
r1 = r.Offset(-1, 0).Address(True, False)
'above to the left
r2 = r.Offset(-1, -1).Address(True, False)
'to the left
r3 = r.Offset(0, -1).Address(False, False)
'(2)*
Debug.Print r.Address & "gets: " & r1 & "+" & r2 & "+" r3
Next
End With
Debug.Print in either case prints in the format:
"$D$10:$D$10 gets: $D$9:$D$9 + $C$8:$C$8 + ... " and so on.
Note:
I'm not saying that (1) and (2) print the same thing.. they both print as expected, it's just the format of what is printed is repeated twice as a range of one cell.
Any thoughts would be greatly appreciated - B
EDIT: When I save and close out of the workbook, the behavior stops and it returns to printing addresses as expected "$D$10 gets: ... "
Please try the following:
Sub dural()
Dim r As Range
Set r = Range("A1")
s = r.Address
s = s & vbCrLf & r.Address(1, 1)
s = s & vbCrLf & r.Address(1, 0)
s = s & vbCrLf & r.Address(0, 1)
s = s & vbCrLf & r.Address(0, 0)
MsgBox s
End Sub
You should see no colons.