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
Related
I'm working on a project and I need a program that will delete the empty columns (other than the header) in columns A through F and column J. I'd like it to loop through Range("A10:F10000") and Range("J:J") and delete the columns from cell A10, B10, etc and down, then shift the remaining data left. I was working with this, that affects the whole worksheet instead of just a range:
ecl = Sheet1.Cells.SpecialCells(xlCellTypeLastCell).Column
For cl = ecl To 1 Step -1
cnt = Application.WorksheetFunction.CountA(Sheet1.Columns(cl))
If cnt = 1 Then
Sheet1.Columns(cl).Delete
End If
Next
I usually can use formulas and am not super familiar with VBA, but for this project it has to be a macro. I hope this makes sense and would appreciate any advise!
you could use this:
Dim cl As Range, colsToDelete As Range
With ActiveSheet 'reference wanted sheet
Set colsToDelete = .UsedRange.Columns(.UsedRange.Columns.Count).Offset(, 1).Resize(1, 1) ' initialize 'colsToDelete' to a "dummy" range certainly out of relevant one
With Intersect(.Range("A10:J" & .UsedRange.Rows(.UsedRange.Rows.Count).Row), .Range("A:F, J:J")) ' reference referenced sheet range in column A to F and G form row 10 down to referenced sheet last not empty cell row
For Each cl In .Columns ' lop through referenced range columns
If Application.WorksheetFunction.CountA(cl) = 1 Then Set colsToDelete = Union(colsToDelete, cl) 'if current column is empty (i.e. only header in row 10) then add it to the colsToDelete range
Next
Set colsToDelete = Intersect(colsToDelete, .Cells) ' get rid of the "dummmy" range
End With
End With
If Not colsToDelete Is Nothing Then colsToDelete.EntireColumn.Delete ' if any range to delete, do it!
I have a worksheet "List" which has rows of data that I need to copy to other worksheets. In column "J" of "List", there is a name (Matthew, Mark, Linda, etc.) that designates who's data that row is.
Each of those names (22 in all) has a matching spreadsheet with the same name. I want all rows that say "Linda" in column "J" to paste to worksheet "Linda", all rows with "Matthew" to paste to worksheet "Matthew", etc.
I have some code below, which mostly works, but I'd have to rewrite it for all 22 names/sheets.
Is there a way to loop through all the sheets, pasting the rows with matching names? Also, the code below works really slowly, and I'm using data sets with anywhere from 200 to 60,000 rows that need sorted and pasted, which means that if its slow on a small data set like the one I'm currently working on, and only for one sheet, it's going to be glacially slow for the big data sets.
Sub CopyMatch()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
Set Source = Worksheets("List")
Set Target = Worksheets("Linda")
j = 4 ' Start copying to row 1 in target sheet
For Each c In Source.Range("J4:J1000") ' Do 1000 rows
If c = "Linda" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
End Sub
Unless you've turned calculation off somewhere we can't see here, then every time you copy a row, Excel is recalculating - even if your sheets contain no formulas.
If you're not doing so already, simply putting:
application.calculation=xlcalculationmanual
before you start your loop and:
application.calculation=xlcalculationautomatic
after exiting the loop will massively speed up your loop. For extra swank, you can use a variable to store the calculation setting before you turn it off and restore that setting at the end, e.g.
dim lCalc as long
lCalc = application.calculation
application.calculation = xlcalculationmanual
for ... next goes here
application.calculation = lCalc
Also consider other settings, e.g.: application.screenupdating=False|True.
Sort the data by the name you're selecting on, then by any other sorts you want. That way you can skip through any size sheet in 22 steps (since you say you have 22 names).
How you copy the data depends on preference and how much data there is. Copying one row at a time is economical on memory and pretty much guaranteed to work, but is slower. Or you can identify the top and bottom rows of each person's data and copy the whole block as a single range, at the risk of exceeding the memory available on large blocks in large sheets.
Assuming the value in your name column, for the range you're checking, is always one of the 22 names, then if you've sorted first by that column you can use the value in that column to determine the destination, e.g.:
dim sTarget as string
dim rng as range
sTarget = ""
For Each c In Source.Range("J4:J1000") ' Do 1000 rows
if c <> "" then ' skip empty rows
if c <> sTarget then ' new name block
sTarget = c
Set Target = Worksheets(c)
set rng = Target.cells(Target.rows.count, 10).end(xlup) ' 10="J"
j = rng.row + 1 ' first row below last name pasted
end if
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
end if
Next
This is economical of memory because you're going row by row, but still reasonably fast because you're only recalculating Target and resetting j when the name changes.
you could use:
Dictionary object to quickly build the list of unique names out of column J names
AutoFilter() method of Range object for filtering on each name:
as follows
Option Explicit
Sub CopyMatch()
Dim c As Range, namesRng As Range
Dim name As Variant
With Worksheets("List") '<--| reference "List" worskheet
Set namesRng = .Range("J4", .Cells(.Rows.count, "J").End(xlUp)) '<--| set the range of "names" in column "J" starting from row 4 down to last not empty row
End With
With CreateObject("Scripting.Dictionary") '<--| instance a 'Dictionary' object
For Each c In namesRng.SpecialCells(xlCellTypeConstants, xlTextValues) '<--| loop through "names" range cells with text content only
.item(c.Value) = c.Value '<--| build the unique list of names using dictionary key
Next
Set namesRng = namesRng.Resize(namesRng.Rows.count + 1).Offset(-1) '<--| resize the range of "names" to have a "header" cell (not a name to filter on) in the first row
For Each name In .Keys '<--| loop through dictionary keys, i.e. the unique names list
FilterNameAndCopyToWorksheet namesRng, name '<--| filter on current name and copy to corresponding worksheet
Next
End With '<--| release the 'Dictionary' object
End Sub
Sub FilterNameAndCopyToWorksheet(rangeToFilter As Range, nameToFilter As Variant)
Dim destsht As Worksheet
Set destsht = Worksheets(nameToFilter) '<--| set the worksheet object corresponding to passed name
With rangeToFilter
.AutoFilter Field:=1, Criteria1:=nameToFilter
Intersect(.Parent.UsedRange, .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow).Copy destsht.Cells(destsht.Rows.count, "J").End(xlUp)
.Parent.AutoFilterMode = False
End With
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 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