I am using the followig code to convert decimals into %.
The number of datapoints in column B will change daily. How can I make the range dynamic so that the code works?
For Each c In [B2:B47]
If c.Value < 1 Then
c.Value = c.Value * 100
End If
c.NumberFormat = "0.00\%"
Next c
Thank you.
I always use a while loop for this task. The loop goes until it reaches a blank cell (i.e. the end of the data)
Sub ranges()
Dim c As Range
Dim n As Integer
n = 2
While Sheets("sheetname").Cells(n, 2) <> ""
Set c = Sheets("sheetname").Cells(n, 2)
If c.Value < 1 Then
c.Value = c.Value * 100
End If
c.NumberFormat = "0.00\%"
n = n + 1
Wend
End Sub
One method is to determine the first and last rows of the range.
Frequently, the first row is known and hard-coded; the last row can be found by starting at the bottom and moving up.
for example
'should always declare your variables
Dim r As Range, c As Range
'should always fully qualify the reference
With ThisWorkbook.Worksheets("sheet4")
Set r = Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
End With
For Each c In r
'do your thing
Next c
Related
Im trying to create a function which scans a column (job-trav-seq) and splits the values in each cell within a given range. It then compares these values to comparable cells in separate columns (so for instance job-trav-seq would have a cell 58546-05-10; this function would remove the dashes and compare the 58546 to job number, 05 to traveller ID and 07 to sequence No.
Basically, the function needs to first takes the A column (JobTravSeq) and breaks it apart into individual variables. (variable 1 should be compared with values in column B, values in variable 2 should be compared with column C and values in variable 3 should be compared with column D)
A loop should go up through the column cells as long as variable 1 = values in column B and variable 2 = values in column C (this is rowStart); this should be stored as a variable
A second loop should occur (rowEnd); which should loop down though the column cells as long as variable 1 = values in column B and variable 2 = values in column C; this should be stored as a variable
The code should then traverse between rowStart and rowEnd and check if variable 3 = values in column D, if it does then place an asterisk (or something similar) in front of the value to mark it as a current task
What im starting with: Sample Doc
What im trying to achieve: SampleDocOutput
any help would be most appreciated
heres my code for reference:
Sub SampleDocOrganise()
Dim i As Integer
Dim LastRow, rowCompare As Long
Dim variArr, rowStart, rowEnd, rangeID As Variant
Dim JobTravSeqRng As Range, jobNoRng As Range, TravellerRng As Range,
opSeqRng As Range, _
rng_JobTravSeq As Range, rng_JobNo As Range, rng_Traveller As Range,
rng_opSeq As Range
Set JobTravSeqRng = Range("A:A")
Set jobNoRng = Range("B:B")
Set TravellerRng = Range("C:C")
Set opSeqRng = Range("D:D")
For Each JobTravSeq In Selection
Str_Array = Split(JobTravSeq, "-")
For h = 0 To UBound(Str_Array)
Range("A:A").Find (Str_Array)
Range.Offset(, h + 1) = Str_Array(h)
For rowStart = 4 To Rows.Count
If Worksheets("Sheet1").Cells(Str_Array, 1).Value = jobNoRng.Value Then
If Cells(Str_Array, 2).Value = jobNoRng.Value Then
Cells.Value = rowStart
End If
End If
Next rowStart
For rowEnd = LastRow To 4 Step -1
If Cells(Str_Array, 1).Value = Range("B:B").Value Then
If Cells(Str_Array, 2).Value = Range("C:C").Value Then
Cells.Value = rowEnd
End If
End If
Next rowEnd
For rowCompare = rowStart To rowEnd
For Each opSeqArr In Str_Array
If Cells(Str_Array, 3).Value = Range("D:D").Value Then
If Cells(Str_Array, 1).Value = Range("B:B") Then
ActiveCell.Characters(0, 0).Insert (" P ")
With ActiveCell.Characters(0, Len(" P ")).Font
.Name = "OpSeq_Equals"
.Bold = True
.Color = -16776961
End With
MsgBox cell.Value = "*" & ""
' if cell changes then go to next loop
Else
' if cell changes then go to next loop
End If
End If
Next
Next
Next h
Next
End Sub
Sub MsgboxTasks() 'should display all rows that contain an asterisk in opSeq (current tasks)
End Sub
I wrote a program using VBA which shown below. there was an array(ary) which contain(C,F,B,PC,PB). I create the loop to go through each variable in the array.
what I want to do with my code is I have a datasheet that includes that array values as categories. I want to assign each array values to p range. then execute data from the p range. then want to assign p to next array value and do the same.
but the problem is range p is firstly set ary(1)="C" and give the correct result. but after it becomes equal to "F" didn't work properly. it contains the same range previously gave. can anyone help me with this problem?
For i = 1 To UBound(ary)
cat = ary(i)
Set p = Nothing
Set c = Nothing
For Each c In Range("E:E")
If c.Value = cat Then
If p Is Nothing Then
Set p = c.Offset
Else
Set p = Union(p, c)
End If
End If
Next c
'get values
p.Offset(, -1).Copy Destination:=ws.Range("N" & Rows.Count).End(xlUp).Offset(1)
next i
The key error in your code is the idea that you might collect a range of non-consecutive cells and paste their value into a contiguous range. Excel can't do that. My code below collects qualifying values into an array and pastes that array into the target range.
The code below can't be exactly what you want because you didn't provide some vital information. However, please try it anyway with the aim of adapting it to your project.
Private Sub Review()
Dim Ws As Worksheet
Dim Rng As Range
Dim Rl As Long ' last row in column E
Dim Ary() As String
Dim Arr As Variant
Dim n As Long
Dim Cell As Range
Dim i As Long
Set Ws = Worksheets("Sheet1")
Ary = Split("C,F,B,PC,PB", ",") ' this array would be 0-based
Rl = Cells(Rows.Count, "E").End(xlUp).Row ' Range("E:E") has 1.4 million cells
Set Rng = Range(Cells(2, "E"), Cells(Rl, "E"))
For i = 0 To UBound(Ary)
ReDim Arr(1 To Rl)
n = 0
For Each Cell In Rng
If Cell.Value = Ary(i) Then
n = n + 1
Arr(n) = Cell.Offset(0, 1).Value
End If
Next Cell
If n Then
ReDim Preserve Arr(n)
'get values
Ws.Cells(Ws.Rows.Count, "N").End(xlUp).Offset(1) _
.Resize(UBound(Arr)).Value = Arr ' Application.Transpose(Arr)
End If
Next i
End Sub
This code works entirely on the ActiveSheet and then pastes the result to another sheet, named as "Sheet1". That isn't good practice. The better way would be to declare variables for both sheets and let the code refer to the variables so as to ensure that it has full control of which sheet it's working on at all times.
Set p = Union(p, c) will never be executed because it will only occur if p is NOT nothing, and Set p = Nothing is executed each time the outer loop iterates.
I am using the OFFSET Function to create a dynamic chart for the table depicted in the image below. Basically on the click of the button labeled "Copy Mean VCD Values" the code copies values from another sheet to the current sheet. If it encounters any cells with "#DIV/0!" I have it set to put "N/A" instead. But in this case I don't get a dynamic chart. If in stead of N/A I do "" it creates a dynamic chart but adds junk values "1" to the first set on the graph. I only get the desired results if I manually delete all the rows containing "N/A" below the last row containing data (See image for details).
https://lh6.googleusercontent.com/-OfjK6dSRQE8/U2JkdadjedI/AAAAAAAAABk/d8WDLuuC7Lk/w1068-h803-no/Offset+error.PNG
This is the code I am using for the Command Button "Copy Mean VCD Values":
Private Sub CommandButton2_Click()
r = 7
'//j increments the column number
'//i increments the row number
'//r is used for taking values from alternate cells(sheet3 column K) rowwise
For j = 2 To 14
For i = 7 To 26
If ThisWorkbook.Sheets(3).Range("K" & r & "").Text = "#DIV/0!" Then
ThisWorkbook.Sheets(2).Cells(i, j).Value = "N/A"
Else
ThisWorkbook.Sheets(2).Cells(i, j).Value = ThisWorkbook.Sheets(3).Range("K" & r & "").Value
End If
r = r + 2
Next i
Next j
End Sub
If I add the following code it works but it deletes the entire rows before and after the table. See image : https://lh6.googleusercontent.com/-WiM8HN61zkM/U2Jz2J_JxjI/AAAAAAAAACw/z4i3hlakyAI/w1598-h442-no/offset+delete+row.PNG
Private Sub CommandButton2_Click()
r = 7
'//j increments the column number
'//i increments the row number
'//r is used for taking values from alternate cells(sheet3 column K) rowwise
For j = 2 To 14
For i = 7 To 26
If ThisWorkbook.Sheets(3).Range("K" & r & "").Text = "#DIV/0!" Then
ThisWorkbook.Sheets(2).Cells(i, j).Value = "N/A"
Else
ThisWorkbook.Sheets(2).Cells(i, j).Value = ThisWorkbook.Sheets(3).Range("K" & r & "").Value
End If
r = r + 2
Next i
Next j
Dim c As Range
Dim SrchRng
Set SrchRng = ActiveSheet.Range("B7:B26")
Do
Set c = SrchRng.Find("N/A", LookIn:=xlValues)
If Not c Is Nothing Then c.EntireRow.Value = ""
Loop While Not c Is Nothing
End Sub
And this is OFFSET Function I am using for Column B in this case:
=OFFSET('Data Summary Template'!$B$7,0,0, COUNTA('Data Summary Template'!$B$7:$B$26),1)
I can't exactly replicate this problem you're having... I think the initial problem must have something to do with the warning regarding invalid references. You should look in to that and figure out the cause, which is probably the cause of "extra" data in your chart.
If deleting the N/A values appears to be working, try something. Instead of:
Set SrchRng = ActiveSheet.Range("B7:B26")
Do
Set c = SrchRng.Find("N/A", LookIn:=xlValues)
If Not c Is Nothing Then c.EntireRow.Value = ""
Loop While Not c Is Nothing
Do this:
Dim tblCell as Range
Dim tbl as ListObject
Set tbl = ActiveSheet.ListObjects(1)
For each tblCell in tbl.DataBodyRange.Columns(2).Cells
If tblCell.Value = "N/A" Then
tblCell.Resize(1, tbl.DataBodyRange.Columns.Count - 1).Value = vbNullString
End If
Next
I am trying to assign a value to all the odd cells in a particular column/range. So far I have the following code taken from another question, but it isnt working:
Sub changeClass()
Dim r As Range
Set r = Range("B16").End(xlDown) 'set the range the data resides in
For i = 1 To r.Rows.Count 'merge step
If i Mod 2 = 1 Then 'this checkes to see if i is odd
r.Cells.Value = "value"
End If
Else
r.Cells.Value = "value2"
Next i
End Sub
Basically I need it to add in a value for every cell in the B column from cell 16 down to the last cell i nthe column which has data in. On the even rows the value will be one thing, on the odd it will be another.
Many thanks!
Sub changeClass()
Dim r As Range
Dim i As Integer
For Each r In Range("B16:B24") 'Change this range
i = r.Row
If i Mod 2 = 1 Then 'this checks to see if i is odd
r.Cells.Value = "ODD"
Else
r.Cells.Value = "EVEN"
End If
Next r
End Sub
Try this out, I believe it is not working, because you are not acessing each individual cell inside your loop. In the following macro i use 'rng' to represent the entire range of cells, and 'r' to represent a single cell in each increment of the loop.
Sub changeClass()
Dim rng As Range
Dim r As Range
Set rng = Range(Cells(16,2),Cells(16,2).End(xlDown))
For i = 1 To rng.Rows.Count
Set r = rng.Cells(i)
If i Mod 2 = 1 Then ' You may want to test if it is odd based on the row number (depends on your problem...)
r.Value = "Odd Value"
Else
r.Value = "Even Value"
End If
Next i
End Sub
you've messed up your if statement, don't close it off before else close it only once you are completely done with it! ;) here:
Sub changeClass()
Dim r As Range
Set r = Range("B16").End(xlDown) 'set the range the data resides in
For i = 1 To r.Rows.Count 'merge step
If i Mod 2 = 1 Then 'this checkes to see if i is odd
r.Cells.Value = "value"
Else
r.Cells.Value = "value2"
End if
Next i
End Sub
You don't need a loop for this:
Sub OddRowAlert()
With Range("B16:B100")
.Formula = "=IF((MOD(ROW(B16),2)),""Odd"",""Even"")"
.Formula = .Value
End With
End Sub
Just replace odd and even in the formula with what you want
Assume Column B has data such as Data1/Data2/Data3-1/Data3-7 - all other rows have various data.
I need to take each row that has that Column B (some may not) and create 1 row for each individual value, with every other piece of data in the row copied for all of them.
Data may have symbols, dashes, and other random stuff, but the actual data itself will not have a / in it, only / is used to designate split lines
Any1 know the best way to do this? Excel 07 and OO available.
Is a VBA solution OK?
Sub DuplicateRows()
Dim r As Range
Set r = Cells(Rows.Count, 2).End(xlUp)
Do While r.Row > 1
TestRow r
Set r = r.Offset(-1, 0)
Loop
TestRow r
End Sub
Sub TestRow(r As Range)
Dim i As Long, n As Long
Dim a() As String
i = InStr(r, "/")
If i > 0 Then
n = Len(r) - Len(Replace(r, "/", ""))
r.EntireRow.Copy
r.Offset(1, 0).Resize(n).EntireRow.Insert Shift:=xlDown
a = Split(r, "/")
For i = 0 To n
r.Offset(i, 0) = a(i)
Next
End If
Application.CutCopyMode = False
End Sub