Print Value Based on Iteration and condition - vba

I Want to Print Values from 1 to 10 or less in blank cells from range(A1:A10)
If we find any non blank cell in range(A1:A10) then we have to skip the cell and print the values without disturbing the series i.e, 1,2,3,A(non Blank Cell),4,5 etc
i tried
Dim i As Integer
For i = 1 To 10
If Sheets("Data").cell("K" & i).Value Is Nothing Then
Sheets("Data").Range("K" & i).Value = i
i = i + 1
End If
Next i

You would be best using a For Each loop and manually incrementing the i variable each time you do print a number, using the iterated cells row as the row to print the value of i to.
Dim i As Integer, c As Range
i = 1
For Each c In Range("A1:A10")
If Len(c.Value) = 0 Then
Sheets("Data").Range("K" & c.Row).Value = i
i = i + 1
End If
Next c

If Sheets("Data").cell("K" & i).Value Is Nothing Then
In your question text, you mention that the range is from A1:A10. In the code, you mention "K". Unless it's a typo, that may one of the reasons. In addition, replace the above if condition with :
If ((Sheets("Data").cell("K" & i).Value Is Nothing) Or (Trim(Sheets("Data").cell("K" & i).Value) = "")) Then

Related

Using something similar to OFFSET for return type Range

I want to create a Do While ... Loop that will step through each cell
in a column and check to see if the value in each cell is a number. It should also keep a count of how many numbers there are before the first non-number entry
But, I don't know what technique to use to step down cell-by-cell... this is what I had first tried (it is simplified and assumes there are numbers in column A starting from row 1 down to an arbitrary row):
Counter = 0
Iteration = Worksheets("Sheet1").Range("A1")
Do While IsNumeric(Iteration) = True And IsEmpty(Iteration) = False
Counter = Counter + 1
Iteration = Iteration.Offset(1,0)
Loop
However, this doesn't work because Offset(1,0) returns the value within the referenced cell. So, I need something similar to Offset but with a return value of type Range. Thank you!
You need to Declare Iteration as Range and Set it.
And the count is not needed:
Dim Iteration as Range
Set Iteration = Worksheets("Sheet1").Range("A1")
Do While IsNumeric(Iteration.Value) And Iteration.Value <> ""
Set Iteration = Iteration.Offset(1,0)
Loop
Sub checkNumber()
For x = 2 To Range("a65536").End(xlUp).Row
If IsNumeric(Range("a" & x).Value) Then
Range("b" & x).Value = "this is a number"
Else
Range("b" & x).Value = "this is not a number"
End If
Next x
End Sub

Cycle through datasets, columns and then rows to add comments based on other cells

I'm trying to make a function to do the following:
Cycle through all my datasets in my sheet
Cycle through each column in my datasets
Look at the title for that column and check if it is in my list.
Find find a few various other columns, but this time using .Find
Now cycle through each row in the column for that specific dataset
Use the column references found in point 4 and the row from point 5 to put the cell's into a variable that will be used on step 7 which is to insert a formatted comment in the originally found column (for that row).
I've tried getting some code working from what I found on a different site but I can't get it working correct, I'm stuck at part 5.
A data example could look like:
My attempted code looks like:
Sub ComTest()
COMLIST = ";Cond;"
Set rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
For Each a In rng.SpecialCells(xlCellTypeConstants).Areas
With a.CurrentRegion
Set r = .Rows(1)
For j = 1 To r.Columns.Count
TitleCell = r.Cells(j).Address
v = ";" & Range(TitleCell).Value & ";"
'-----------------------------------------------------------------------------------------
If InStr(1, COMLIST, v) Then
On Error Resume Next
xRange = .Offset(1).Resize(.Rows.Count - 1).Columns(j).Address
For i = 1 To UBound(xRange)
v = b.Value
Next i
Condw = r.Columns.Find(Replace(v, ";", "") & " " & "w", lookAt:=xlWhole).Column
Condw = .Cells(r, Condw).Address
' Add more stuff here
End If
'-----------------------------------------------------------------------------------------
Next j
End With
Next a
End Sub
As for part 7, the output would essentially be as follows for "row 1" but this part I should be able to do, it's the looping part that I am struggling with.
This question raises a few points that this answer might resolve for you and others in the future:
I note that not many of your previous questions have accepted answers, and that several of them present answers but you have needed to respond by saying it doesn't suit your needs for a certain reason. It suggests you aren't really providing the right details in your question. I think that's the case here. Perhaps you could outline the outcome you are trying to achieve and, especially for Excel VBA, the precise structure of your spreadsheet data. It's tempting to think in this question that you simply want to know how to take the values of Columns C to F and write them to a comment in Column B for any row that contains data.
Using web code can often take more time to understand and adapt than learning the code syntax from first principles. Your provided code is difficult to follow and some parts seem odd. I wonder, for example, what this snippet is meant to do:
xRange = .Offset(1).Resize(.Rows.Count - 1).Columns(j).Address
For i = 1 To UBound(xRange)
v = b.Value
Next i
Using Option Explicit at the top of your module (which forces you to declare your variables) makes VBA coding and debugging much easier, and code submitted on SO is easier to follow if we can see what data types you meant variables to hold.
If your question is merely "How do I take the values of Columns C to F and write them to the cell in Column B for any row that contains data?", then your code could be as simple as:
Dim condCol As Range
Dim cell As Range
Dim line1 As String
Dim line2 As String
Dim cmt As Comment
'Define the "Cond" column range
'Note: this is an unreliable method but we'll use it here for the sake of brevity
Set condCol = ThisWorkbook.Worksheets("Sheet1").UsedRange.Columns("B")
'Delete any comment boxes
condCol.ClearComments
'Loop through the cells in the column and process the data if it's a number
For Each cell In condCol.Rows
If Not IsEmpty(cell.Value) And IsNumeric(cell.Value) Then
'Acquire the comment data
line1 = "Cond: " & cell.Offset(, 1).Value & "/" & cell.Offset(, 2).Value & _
" (" & Format(cell.Offset(, 3), "0.00%") & ")"
line2 = "Cond pl: $" & cell.Offset(, 4).Value
Set cmt = cell.AddComment(line1 & vbCrLf & line2)
'Format the shape
With cmt.Shape.TextFrame
.Characters(1, 5).Font.Bold = True
.Characters(Len(line1 & vbCrLf), 8).Font.Bold = True
.AutoSize = True
End With
End If
Next
If, on the other hand, your question is that you have unreliable data on your spreadsheet and your only certainty is that the headings exist on any one row, then some form of search routine must be added. In that case your code could look like this:
Dim rng As Range
Dim rowRng As Range
Dim cell As Range
Dim condCol(0 To 4) As Long
Dim line1 As String
Dim line2 As String
Dim allHdgsFound As Boolean
Dim i As Integer
Dim cmt As Comment
Set rng = ThisWorkbook.Worksheets("Sheet1").UsedRange
rng.ClearComments
For Each rowRng In rng.Rows
If Not allHdgsFound Then
'If we haven't found the headings,
'loop through the row cells to try and find them
For Each cell In rowRng.Cells
Select Case cell.Value
Case Is = "Cond": condCol(0) = cell.Column
Case Is = "Cond w": condCol(1) = cell.Column
Case Is = "Cond r": condCol(2) = cell.Column
Case Is = "Cond %": condCol(3) = cell.Column
Case Is = "Cond wpl": condCol(4) = cell.Column
End Select
Next
'Check if we have all the headings
'by verifying the condCol array has no 0s
allHdgsFound = True
For i = 0 To 4
If condCol(i) = 0 Then
allHdgsFound = False
Exit For
End If
Next
Else
If Not IsEmpty(rowRng.Cells(1).Value) Then
'The cell has values so populate the comment strings
line1 = "Cond: " & rowRng.Columns(condCol(1)).Value & "/" & _
rowRng.Columns(condCol(2)).Value & _
" (" & Format(rowRng.Columns(condCol(3)).Value, "0.00%") & ")"
line2 = "Cond pl: $" & rowRng.Columns(condCol(4))
Set cmt = rowRng.Columns(condCol(0)).AddComment(line1 & vbCrLf & line2)
'Format the shape
With cmt.Shape.TextFrame
.Characters(1, 5).Font.Bold = True
.Characters(Len(line1 & vbCrLf), 8).Font.Bold = True
.AutoSize = True
End With
Else
'We've reached a blank cell so re-set the found values
allHdgsFound = False
Erase condCol
End If
End If
Next
Of course your data might be structured in any number of other ways, but we don't know that. My point is that if you can be more specific in your question and provide an outcome you are trying to achieve, you are likely to receive answers that are more useful to you.

VBA: match of a variable range

I have a problem. For a certain spreadsheet I want to find out the position (only column) of a value smaller than threshold (further called maxt). I have to solve this in VBA as I need them on a different worksheet to give out accumulated numbers.
I am able to retrieve the max smaller than threshold but the vba match function gives back an error that the number couldnt be found.
However, if the value maxt is copied to a cell and I use the the normal match function on the sheet with the cell containing maxt as condition (=MATCH(cell of maxt; range), it works without any issues.
Problem (I only have A to C filled in my example; irrelevant as it doesnt work on only a few constellations).
A B C
8 5 6 -> doesn't work (Error: 1004)
5 6 7 -> works
7 6 7 -> works
4 8 5 -> works
Below is the code.
Dim myVar As Double
Dim myVarAdress As Long
For I = 1 To 10
myVar = Evaluate("=MAX(IF(A" & I & ":M" & I & "<6, A" & I & ":M" & I & "))")
myVarAdress = Application.WorksheetFunction.Match(myVar, Range("A" & I & ":M" & I))
Next I
End Sub
Thanks in advance
Change myVarAdress = Application.WorksheetFunction.Match(myVar, Range("A" & I & ":M" & I))
to myVarAdress = Application.WorksheetFunction.Match(myVar, Range("A" & I & ":M" & I), 0)
That "0" means that you are looking for the exact match. Also you should add a conditon that will skip the 0 value of your "myVar" variable. For example:
If myVar > 0 Then
myVarAdress = Application.WorksheetFunction.Match(myVar, Range("A" & i & ":M" & i), 0)
End If
Your setup has a couple of different problems that must be addressed before a true solution can be found.
1) You are trying to evaluate a MAX() function, that only has one argument. Your IF() function will either return a value less than 6, or FALSE (0). So either your MAX() function is irrelevant, your IF() function is irrelevant, or you left out one or more arguments on either/both of those functions. In any case, there is no set behavior for what to do when there is no item less than 6 in a row. This raises the possibility that myVar is 0, which is likely to cause faulty results because:
2) You left off the third argument in the MATCH() function. Because your range is (currently) larger than your data set, when you leave off the third argument for MATCH() it will fail any time the data is not organized correctly. This is particularly problematic when you are returning FALSE from your IF() function (treated as 0 by MAX()) because MATCH() is matching to the blanks in your data. Which means that the size of your data set does matter. If you had all 13 rows filled in, your first line would (probably) not fail, but it would not actually match to the 5 you want it to if there were any values LOWER than 5 to the right of column B. Also, it potentially causes some of the other lines to fail if suddenly there aren't any values below 6 in any of the columns and there are no blanks for MATCH() to find and treat as a 0.
All that being said, without further clarification of how you want to clean up these problems, here is a proposed solution (that assumes you want the first occurrence of your max value less than 6, regardless of how many occurrences there are):
Sub MatchSub()
Dim myVar As Double
Dim myVarAdress As Long
Dim rngMaxT As Range
Dim wsFindMax As Worksheet
Set wsFindMax = ActiveSheet
For i = 1 To 10
myVar = Evaluate("=IF(A" & i & ":M" & i & "<6, A" & i & ":M" & i & ")")
Set rngMaxT = wsFindMax.UsedRange.Rows(i)
If rngMaxT(1, 1).Value = myVar Then
myvaraddress = 1
Else
Set rngMaxT = rngMaxT.Find(myVar, , xlValues, xlWhole, xlByRows, xlNext, False)
If rngMaxT Is Nothing Then
'There is no value in the row less than 6
Else
myVarAdress = rngMaxT.Column
End If
End If
Next i
End Sub

excel VBA : how to skip blank cells between 2 cells that contain values?

I am working out a button that can auto sum value at column C that column A = column B
like the picture :
PIC:
I can only copy the value in column C (that the word in column A = column B) to column E so far.
the code
Private Sub CommandButton2_Click()
Dim i As Integer, q As Integer
q = 2
For i = 3 To 100
Range("E" & q).Value = Range("b" & 3).Value
If Range("B" & i).Value = "A-RDL1" And Range("c" & i).Value = "OPEN" Then
Range("E" & i).Value = Range("d" & i).Value
End If
Next i
End Sub
the question 1) is how can I skip the blanks E9 to E17, so the numbers can be continuous? (AFTER CLICK THE BOTTON)
question 2) is it possible to auto sum the Numbers in column E instead of show each?
Thanks a lot and sorry for my poor English...
1) Yes, you can skip those, just carry out a check in the cell value and compare to empty string: Range("").Value2 = "". I personally prefer to do it like this though, to avoid false positives: Len(Trim(Range("").Value2)) = 0.
2) Yes, you can do that. just declare an Integer variable or two and use that to carry out a running count of your values.

Am I using the isnumeric function correctly?

This program is to convert a column of data from cumulative to non-cumulative. On my sheet I have A1, B1, and C1 with the text Non-Cumulative, Cumulative, and Converted, respectively. I have numbers 1 to 10 beneath A1, then them summed cumulatively beneath B1. C1 is where I want to convert column B back to non-cumulative.
The IsNumeric is used to make the first row of data in C equal to the first row of data in B. It should detect that the title is above the number it is evaluating, thus knowing that no calculations have to be performed. For the rest of them, it'll see that the number above the one it is evaluating is a number, and thus the calculation has to be done.
My problem is that it isn't working. I think the reason is because IsNumeric() keeps coming back as false. Is there a different function I should be using? Do cell references not work in IsNumeric?
Here's the program!
Option Explicit
Dim i As Variant
Sub Conversion()
Sheets("Test Sheet").Select
For i = 1 To 10
If IsNumeric("B" & i) = False Then
Range("C" & i + 1) = Range("B" & i + 1)
Else: Range("C" & i + 1) = Range("B" & i + 1) - Range("B" & i - 1)
End If
Next
End Sub
The way you wrote your code is logical, just a minor syntax changes you need initially. However,
It's also best to check if the range is empty first...
Then check on if the value is numeric.
Better even, if you set the Range into a Range object and use offset
Code:
Option Explicit '-- great that you use explicit declaration :)
Sub Conversion()
Dim i As Integer '-- integer is good enough
Dim rngRange as Range
'-- try not to select anything. And for a cleaner code
Set rngRange = Sheets("Test Sheet").Range("B1")
For i = 1 To 10
If (rangeRange.Offset(i,0).value) <> "" then '-- check for non-empty
If IsNumeric(rangeRange.Offset(i,0).value) = False Then
rangeRange.Offset(i+1,1) = rangeRange.Offset(i+1,0)
Else
rangeRange.Offset(i+1,1) = rangeRange.Offset(i+1,0) - rangeRange.Offset(i-1,0)
End If
End if
Next i '-- loop
End Sub
To make your code more dynamic:
Another suggestion, you may simply Application.WorkSheetFunction.Transpose() the entire B column range that you need to validate into a variant array
Process the array and Transpose back to the Range with column B and C.
By doing so, you may omit setting for loop size manually but setting it using Lower and Upper bound of the array ;)
You need to check if the range of B i is numeric, not the string "B" & i
and rather than selecting the sheet, simply using a parent identifier like:
sheets("sheet1").range("B" & i)
This will help you avoid errors in your code
For i = 1 To 10
If IsNumeric(sheets("test sheet").range("B" & i).value) = False Then
Range("C" & i + 1) = Range("B" & i + 1)
Else: Range("C" & i + 1) = Range("B" & i + 1) - Range("B" & i - 1)
End If
Next