Hello stackoverflow community,
I must confess I primarily code within MS Access and have very limited experience of MS Excel VBA.
My current objective is this, I have an expense report being sent to me with deductions in another countries currency, this report has many columns with different account names that may be populated or may be null.
I currently have a Macro that will open an input box and ask for the HostCurrency/USD Exchange rate, my next step will be to start at on the first record (Row 14; Column A-K contains personal info regarding the deduction) then skip to the first deduction account (deduction accounts start at column L and span to column DG) checking if each cell is null, if it is then keep moving right, if it contains a value then I want to multiply that value by my FX rate variable that was entered in the input box, and update the cell with the converion. Once the last column (DG) has been executed I want to move to the next row (row 15) and start the process again all the way until the "LastRow" in my "Used Range".
I greatly appreciate any feedback, explanations, or links that may point me towards my goal. Thank you in advance for taking the time to read though this!
First off, you really should attempt to write the code yourself and post what you have so someone can try to point you in the right direction. If your range is going to be static this is a very easy problem. You can try something along the lines of:
Sub calcRate(rate As Double, lastrow As Integer)
Dim rng As Range
Set rng = Range("L14" & ":DG" & lastrow)
Dim c As Variant
For Each c In rng
If c.Value <> "" Then
c.Value = c.Value * rate
End If
Next
End Sub
This code will step through each cell in the given range and apply the code without the need for multiple loops. Now you can call the calcRate sub from your form where you input the rate and lastrow .
This will do it without looping.
Sub fooooo()
Dim rng As Range
Dim mlt As Double
Dim lstRow As Long
mlt = InputBox("Rate")
With ActiveSheet
lstRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rng = .Range(.Cells(14, 12), Cells(lstRow, 111))
rng.Value = .Evaluate("IF(" & rng.Address & " <>""""," & rng.Address & "*" & mlt & ","""")")
End With
End Sub
If your sheet is static you can replace ActiveSheet with WorkSheets("YourSheetName"). Change "YourSheetName" to the name of the sheet.
Related
I populated an excel sheet with the locations of blank cells in my sheet using suggestions from this post. So I have a Column A filled with locations in the following format
$X$1 or $X2:$X$4.
What I am trying to do is use those row numbers from the column explain above to populate a separate column. I want to use the row numbers as a reference in what to populate for the column. So a Column B looking something like
=$B$1 or =$B$2:$B$4 (took 1 and 2-4 and used it as row number for reference call)
Both columns are referencing a different sheet so please excuse any column naming.
I'm not sure if this is going to require VBA or if I can get away with just using a formula, I expect VBA due to desired specifics. I've looked at post like this and this. But neither of these fully encompass what I'm looking for. Especially since I want it to express all the contents in a $B$2:$B$4 case.
My intuition on how to solve this problem tells me, parse the string from Column A for the 1st number then check if it's the end of the string. If it is, feed it to the reference that populates Column B, if not then find the 2nd number and go through a loop that populates the cell (would prefer to keep all the content in one cell in this case) with each value for each reverence.
i.e.
=$B2
=$B3
=$B4
My question is how do I go about this? How do I parse the string? How do I generate the loop that will go through the necessary steps? Such as using the number as a reference to pull information from a different column and feed it neatly into yet another column.
If (for example) you have an address of $X2:$X$4 then
Dim rng As Range
Set rng = yourSheetReference.Range("$X2:$X$4")
If you want to map that to the same rows but column B then
Set rng = rng.Entirerow.Columns(2)
will do that. note: it's not so clear from your question whether you're mapping X>>B or B>>X.
Once you have the range you want you can loop over it:
For Each c in rng.Cells
'do something with cell "c"
next c
Something like this should work for you:
Sub Tester()
Dim shtSrc As Worksheet, c As Range, rng As Range, c2, v, sep
Set shtSrc = ThisWorkbook.Worksheets("Sheet1") '<< source data sheet
Set c = ActiveSheet.Range("A2") '<<range addresses start here
'process addresses until ColA is empty
Do While c.Value <> ""
'translate range to (eg) Column X
Set rng = shtSrc.Range(c.Value).EntireRow.Columns(24)
sep = ""
v = ""
'build the value from the range
For Each c2 In rng.Cells
v = v & sep & c2.Value
sep = vbLf
Next c2
c.Offset(0, 1) = v '<< populate in colB
Loop
End Sub
Try this code:
Sub Test()
Dim fRng As Range ' the cell that has the formula
Set fRng = Worksheets("sheet1").Range("A1")
Dim tWS As Worksheet 'the worksheet that has the values you want to get
Set tWS = Worksheets("sheet2")
Dim r As Range
For Each r In Range(fRng.Formula).Rows
'Debug.Print r.Row ' this is the rows numbers
Debug.Print tWS.Cells(r.Row, "N").Value 'N is the column name
Next
End Sub
I have a workbook with "Results" being sheet 3, this being the worksheet I want to use.
I have tried a few formulaes to try and add a macro to do the following:
I have column G with percentages. I then have column I where I would like there to be a result saying TRUE/FALSE where the contents of G are equal to 100%. Column G is formatted to percentage with two decimals.
Some considerations: I have my first row being a Hyperlink to another sheet, then my headings, then the first row of "results". I have 457 rows, if there is a measurement of the range, perhaps it could be on A?
I keep getting this error 9 with my range and have got a bit stuck.
Thanks in advance!
Sub PartialHits1()
Dim rng As Range
Dim lastRow As Long
Dim cell As Range
With Sheet3
lastRow = .Range("G" & .Rows.Count).End(xlUp).Row
Set rng = .Range("G1:G" & lastRow)
For Each cell In rng
If cell.Value = 100
Then
cell.Range("I1:I1").Value = 100
End If
Next
End With
End Sub
(I have hacked this a bit, just was trying to get it to set as 100 instead of the TRUE/FALSE Also was playing around near the Sheet 3 part as I got errors.)
RangeVariable.Range can refer only to a cell within RangeVariable, so you can't refer to column I in this way. Try: .Range("I"&cell.row)=100.
Also your criteria is probably wrong, if you have 100% in a cell it's actual value is 1.
And last question: why do you want to do this with VBA, it would be much more simple with worksheet function =IF(G3=1,100,"")
I am trying to create a VBA macro which will search the rows on the basis of the following criteria:
First it will look for a name specified in the macro in the name column.
If the name is found it will proceed to check the 'submitted' column and check whether the submitted date is between a weekly date. (like if the date is between 2/23/2015-2/27/2015).
If the date lies between the specified dates then the macro will group the activities based on their names and add the number of hours based on the values in the hours tab.
This whole data is finally to be copied and pasted into another worksheet in the same workbook.
So far I have only been able to get to searching for the names part and being a newbie to VBA macro I have absolutely no idea of how to proceed.
So far I have done pathetically since yesterday to come up with a solution. Please help. I am attaching my code, though I wonder if its of any use
Sub Demo()
Dim rngCell As Range
Dim lngLstRow As Long
Dim strFruit() As String
Dim intFruitMax As Integer
intFruitMax = 3
ReDim strFruit(1 To intFruitMax)
strFruit(1) = "A"
strFruit(2) = "B"
strFruit(3) = "C"
lngLstRow = ActiveSheet.UsedRange.Rows.Count
For Each rngCell In Range("J2:J" & lngLstRow)
For i = 1 To intFruitMax
If strFruit(i) = rngCell.Value Then
rngCell.EntireRow.Copy
Sheets("Inventory").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial xlPasteValues
Sheets("Sheet1").Select
End If
Next i
Next
End Sub
I believe the points below will allow you to progress although it cannot be a full answer because you do not give enough information for that. Warning: I do not explain my macros fully. Look up Help for the statements I use and try to work out why they have the effect they do. Come back with questions as necessary but the more you can work out for yourself, the more you will develop your VBA knowledge.
lngLstRow = ActiveSheet.UsedRange.Rows.Count
It is best to avoid ActiveSheet and UsedRange unless you know exactly what you are doing.
If you use the active worksheet, you are relying on the user having the correct worksheet active when they start the macro. You may one day want to allow the user to select which worksheet is the target for a macro but I doubt that is the case here. If possible be explicit. For example:
With Worksheets("New Data")
.Range("A1").Values = "Date"
End With
Above I explicit specify the worksheet I wish to use. It does not matter what worksheet is active when the user starts the macro. If I come back to the macro after six months, I do not have to remember which of the 20 worksheets it operates on.
Excel’s definition of UsedRange does not always mean what the programmer thinks its means. Do not use it until you have tried it out on a variety of test worksheets. In particular, try (1) formatting cells outside the range with values and (2) leaving the left columns and top rows unused. Try Debug.Print .UsedRange.Address. You will be surprised at some of the ranges you get.
Create a new workbook. Place values in E4, C7 and B10. Merge cells F12 and F13 and place a value in the merged area. It does not matter what those values are.
Copy this macro to a module and run it:
Option Explicit
Sub Test1()
Dim ColFinal As Long
Dim RowFinal As Long
Dim RowFinalC As Long
With Sheets("Sheet1")
RowFinal = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
ColFinal = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
RowFinalC = .Cells(Rows.Count, "C").End(xlUp).Row
End With
Debug.Print "ColFinal" = ColFinal
Debug.Print "RowFinal" = RowFinal
Debug.Print "RowFinalC" = RowFinalC
End Sub
The output will be:
ColFinal=5
RowFinal=12
RowFinalC=7
In most cases, Find is the best way of locating the last row and/or column of a worksheet. What:="*"means look for anything. Notice that I have different values for SearchOrder. It does not matter that the worksheet is not rectangular; the last row and the last column do not have to be the same cell.
However, there is no method of finding the last row or column that works in every situation. Find has not “seen” the merged cell when searching by column. (Warning, I am using an old version of Excel and this may have been fixed in your version.)
You want the last used cell in column J. My technique for finding the last row in column C may be the easiest technique for you.
Consider:
intFruitMax = 3
ReDim strFruit(1 To intFruitMax)
strFruit(1) = "A"
strFruit(2) = "B"
strFruit(3) = "C"
For i = 1 To intFruitMax
Next i
There is nothing wrong with your code but this macro shows a different approach that may be more convenient:
Sub Test2()
Dim Fruit() As Variant
Dim InxFruit As Long
Fruit = Array("A", "B", "C")
For InxFruit = LBound(Fruit) To UBound(Fruit)
Debug.Print Fruit(InxFruit)
Next
End Sub
It is becoming uncommon to have a three letter prefix specifying the type of a variable. As someone asked: “Is strFruit really more useful than Fruit?”. Avoid variable names like i. It probably does not matter with such a small macro but I have tried to decipher macros with a bunch of meaningless names and can assure you it is a nightmare. InxFruit says this is an index into array Fruit. I can look at macros I wrote years ago and immediately know what all the variables are.
LBound(Fruit) will always be zero if you use Array. Note also that Fruit has to be of type Variant. The advantage is that when you want to add fruits D and E, you just change to:
Fruit = Array("A", "B", "C", "D", "E")
If the name is found it will proceed to check the 'submitted' column and check whether the submitted date is between a weekly date. (like if the date is between 2/23/2015-2/27/2015).
Your technique for finding rows for interesting fruit is not the best technique but I think it is good enough. I am giving you enough to think about without discussing other approaches.
I am guessing you want to know if the date is between Monday and Friday of the current week.
Now() gives you the current date and time. The next macro shows how to calculate the Monday and Friday for any day of a week. If you chose to copy this technique, please document it properly for the benefit of the poor sod who has to update your macro in a year’s time. This macro is all clever arithmetic with functions and constants. I do not like clever code, unless it is properly documented, because it is usually the programmer showing off rather than solving the problem using the simplest method.
Sub Test3()
Dim Friday As Date
Dim InxDate As Long
Dim Monday As Date
Dim TestDates() As Variant
Dim Today As Date
Dim TodayDoW As Long
TestDates = Array(DateSerial(2015, 2, 22), DateSerial(2015, 2, 23), _
DateSerial(2015, 2, 24), DateSerial(2015, 2, 25), _
DateSerial(2015, 2, 26), DateSerial(2015, 2, 27), _
DateSerial(2015, 2, 28), Now())
For InxDate = 0 To UBound(TestDates)
Today = TestDates(InxDate)
TodayDoW = Weekday(Today)
Monday = DateSerial(Year(Today), Month(Today), Day(Today) + vbMonday - TodayDoW)
Friday = DateSerial(Year(Today), Month(Today), Day(Today) + vbFriday - TodayDoW)
Debug.Print "Today=" & Format(Today, "ddd d mmm yy") & _
" Monday=" & Format(Monday, "ddd d mmm yy") & _
" Friday=" & Format(Friday, "ddd d mmm yy")
Next
End Sub
Note that Excel holds dates as numbers so you can write If Monday <= TransDate And TransDate <= Friday Then.
Your technique for moving data from one worksheet to another is clumsy. This macro moves every row with “A”, “a”, “B”, “b”, “C” or “c” in column J from worksheet “Sheet2” to “Sheet3”. I believe you will agree the innermost loop in clearer than yours.
Sub Test4()
' I assume row 1 contains column headers and is not to be copied
' to the new worksheet. Constants are a good way of making such
' assumptions explicit and easy to change if for example to add
' a second header row
Const RowSht2DataFirst As Long = 2 ' This only applies to Sheet2
Const ColFruit As Long = 10 ' This applies to both sheets
Dim Fruit() As Variant
Dim FruitCrnt As String
Dim InxFruit As Long
Dim RowSht2Crnt As Long
Dim RowSht2Last As Long
Dim RowSht3Next As Long
Dim Wsht2 As Worksheet
Dim Wsht3 As Worksheet
' It takes VBA some time to evaluate Worksheets("Sheet2") and
' Worksheets("Sheet3"). This means it only has to do it once.
Set Wsht2 = Worksheets("Sheet2")
Set Wsht3 = Worksheets("Sheet3")
' BTW Please don't use the default names for a real workbook.
' It is so much easier to understand code with meaingful names
Fruit = Array("A", "B", "C")
With Wsht3
' Place new rows under any existing ones.
RowSht3Next = .Cells(Rows.Count, ColFruit).End(xlUp).Row + 1
End With
With Wsht2
RowSht2Last = .Cells(Rows.Count, ColFruit).End(xlUp).Row
For RowSht2Crnt = RowSht2DataFirst To RowSht2Last
FruitCrnt = UCase(.Cells(RowSht2Crnt, ColFruit).Value)
For InxFruit = LBound(Fruit) To UBound(Fruit)
If Fruit(InxFruit) = FruitCrnt Then
.Rows(RowSht2Crnt).Copy Destination:=Wsht3.Cells(RowSht3Next, 1)
RowSht3Next = RowSht3Next + 1
Exit For
End If ' Match on fruit
Next InxFruit
Next RowSht2Crnt
End With ' Wsht3
End Sub
I have already created a VBA script that is about 160 lines long, which produces the report that you see below.
Without using cell references (because the date ranges will change each time I run this) I now need to take the users ID, name, total hours, total break, overtime 1, and overtime 2 and copy this data into sheet 2.
Any suggestions as to how I can structure a VBA script to search row B until a blank is found, when a blank is found, copy the values from column J, K, L, M on that row, and on the row above copy value C - now paste these values on sheet 2. - Continue this process until you find two consecutive blanks or the end of the data...
Even if you can suggest a different way to tackle this problem than the logic I have assumed above it would be greatly appreciated. I can share the whole code if you are interested and show you the data I began with.
Thank you in advance,
J
As discussed, here's my approach. All the details are in the code's comments so make sure you read them.
Sub GetUserNameTotals()
Dim ShTarget As Worksheet: Set ShTarget = ThisWorkbook.Sheets("Sheet1")
Dim ShPaste As Worksheet: Set ShPaste = ThisWorkbook.Sheets("Sheet2")
Dim RngTarget As Range: Set RngTarget = ShTarget.UsedRange
Dim RngTargetVisible As Range, CellRef As Range, ColRef As Range, RngNames As Range
Dim ColIDIndex As Long: ColIDIndex = Application.Match("ID", RngTarget.Rows(1), 0)
Dim LRow As Long: LRow = RngTarget.SpecialCells(xlCellTypeLastCell).Row
'Turn off AutoFilter to avoid errors.
ShTarget.AutoFilterMode = False
'Logic: Apply filter on the UserName column, selecting blanks. We then get two essential ranges.
'RngTargetVisible is the visible range of stats. ColRef is the visible first column of stats.
With RngTarget
.AutoFilter Field:=ColIDIndex, Criteria1:="=", Operator:=xlFilterValues, VisibleDropDown:=True
Set RngTargetVisible = .Range("J2:M" & LRow).SpecialCells(xlCellTypeVisible)
Set ColRef = .Range("J2:J" & LRow).SpecialCells(xlCellTypeVisible)
End With
'Logic: For each cell in the first column of stats, let's get its offset one cell above
'and 7 cells to the left. This method is not necessary. Simply assigning ColRef to Column C's
'visible cells and changing below to CellRef.Offset(-1,0) is alright. I chose this way so it's
'easier to visualize the approach. RngNames is a consolidation of the cells with ranges, which we'll
'copy first before the stats.
For Each CellRef In ColRef
If RngNames Is Nothing Then
Set RngNames = CellRef.Offset(-1, -7)
Else
Set RngNames = Union(RngNames, CellRef.Offset(-1, -7))
End If
Next CellRef
'Copy the names first, then RngTargetVisible, which are the total stats. Copying headers is up
'to you. Of course, modify as necessary.
RngNames.Copy ShPaste.Range("A1")
RngTargetVisible.Copy ShPaste.Range("B1")
End Sub
Screenshots:
Set-up:
Result:
Demo video here:
Using Filters and Visible Cells
Let us know if this helps.
I'm just getting started with VBA for Excel. I used VB and Java in college nearly ten years ago and was competent with it then, but am essentially starting over. (Um, not like riding a bike.)
I am trying to understand the methods to build a range that isn't just declared as A1:J34 or whatever. My Googling is challenged in that when searching for 'range' and terms that indicate what I seek, I get an avalanche of hits far more advanced than what I need, mostly hits that don't even address the basic summary info I need.
So, here's the basics of it:
Excel 2011 on Mac.
The sheet has data from A to M, down to 1309.
It's a repeating pattern of heading rows followed by data rows. Ugh. Seems like the person creating the sheet was more thinking about printing from the sheet than the organisation of the data. I need to clean it and 3 more like it up to use in a pivot table, and it's useless in this silly repeating layout.
Heading rows are as follows:
Last Name, First Name, then 10 date cells.
Data rows under the headings are the names, of course, and then a 1 or 0 for attendance.
Anywhere from 20 to 30 names under each heading. Then it repeats. And the dates change every few sets, picking up where the last set left off.
What I need to do right now:
I'm trying to assemble a range into a range variable by adding all the rows beginning with a specific value (in column A). In my case that value is the string "Last Name", so I can have the range variable holding all the cells in all rows that begin with "Last Name". This will then capture all the cells that need to be in date format. (I'm doing it so I can then make sure the date headings are all actually IN date format - because they are NOT all in date format now, many are just 'General' cells.)
My questions:
When telling a range object what it's range IS, how do you feed it cells/rows/columns that are not just a block defined by start and end cells entered by the person writing the code but based on row criteria? Eg: Create a Range that has rows 1, 34, 70, 93, and 128 from columns A to I based on presence of "First Name" in A.
What are the most common methods to do this?
Which of these is best suited to my need and why?
Here's a working example that demonstrates finding the "Last Name" rows, contructing a range object that includes all those rows, and then iterating through that object to search for non-date values. The code could be speeded up greatly by reading the data range into an array of variants and then searching the array for both the last name rows and the "bad dates" within those rows. This is especially true if you have a very large number of rows to check.
Sub DisjointRng()
Dim checkCol As String, checkPattern As String
Dim dateCols()
Dim lastCell As Range, usedRng As Range, checkRng As Range
Dim cell As Variant
Dim usedRow As Range, resultRng As Range, rngArea As Range
Dim i As Long, j As Long
checkCol = "A" 'column to check for "Last Name"
checkPattern = "Last*"
dateCols = Array(3, 5) 'columns to check for date formatting
With Worksheets("Sheet1")
'find the bottom right corner of data range; we determine the used range
'ourselves since the built-in UsedRange is sometimes out-of-synch
Set lastCell = .Cells(.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row, _
.Cells.Find(What:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column)
Set usedRng = .Range("A1:" & lastCell.Address)
'the column of values in which to look for "Last Name"
Set checkRng = .Range(checkCol & "1:" & checkCol & usedRng.Rows.Count)
End With
'step down the column of values to check for last name & add
'add found rows to range object
For Each cell In checkRng
If cell.Value Like checkPattern Then
'create a range object for the row
Set usedRow = Intersect(cell.EntireRow, usedRng)
If resultRng Is Nothing Then
'set the first row with "Last Name"
Set resultRng = usedRow
Else
'add each additional found row to the result range object
Set resultRng = Union(resultRng, usedRow)
End If
End If
Next cell
For Each rngArea In resultRng.Areas
'if found rows are continguous, Excel consolidates them
'into single area, so need to loop through each of the rows in area
For i = 1 To rngArea.Rows.Count
For j = LBound(dateCols) To UBound(dateCols)
If Not IsDate(rngArea.Cells(i, dateCols(j))) Then
'do something
End If
Next j
Next i
Next rngArea
End Sub
You can use the Union operator, like this
Dim r As Range
Set r = Range("A1, A3, A10:A12")
or this
Set r = Union(Range("A1"), Range("A3"), Range("A10:A12"))
You can the iterate this range like this
Dim cl as Range
For Each cl in r.Cells
' code cell cl
Next
or this
Dim ar as Range
For each ar in r.Areas
' code using contiguous range ar
For each cl in ar.Cells
' code using cell cl
Next
Next