Excel VBA; Referencing Variable Ranges - vba

I'm trying to automate a process that takes a monthly report and generates an exception report based on the data. Since the volume of the data in the report varies from month to month, i need to account for that. What methodology is best for referencing a variable range?
For example, instead of referencing the range A1:F7087, i want to reference the entire range that includes any data. For as simple as this appears to be, I haven't been able to find any guidance on it. Appreciate any input. Thanks

Dim rng As Range
Set rng = Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
This will set rng to contain all cells up to last filled, it will also contain all empty rows and columns.
You should also read this, important part from this article about xlLastCell:
Depending on what you are trying to accomplish, this cell may not be the cell that you are actually looking for. This is because, for example, if you type a value into cells A1,A2, and B1, Excel considers the last cell to be B2, which could have a value or not...

There are pros and cons with just about any method you choose to reference the dynamic block of data you wish to include with your report.
The caveat that comes with .SpecialCells(xlLastCell) is that it may encompass a cell that was previously used but is no longer within the scope of the data. This could occur if your data shrinks from one month to the next although recent service packs and updates provided for Excel 2010/2013 will shrink the rogue last cell through saving the workbook. I'm sure many of us have at one time or another mistyped a value into AZ1048576 and had to jump through hoops getting Excel to internally resize the extents of the actual data. As mentioned, with later versions of Excel, this problem is all but a footnote in history.
One last thing to note is that cells formatted as anything but plain-Jane General will halt the shrink so if last month's report had a formatted Subtotal line 50 rows below where it is this month, the .SpecialCells(xlLastCell) will be referencing an area 50 rows too long.
If you have a contiguous block of data with some blank cells possible but no fully blank rows or columns that segregate your data into islands then I prefer the following approach.
With sheets("Sheet1")
Set rng = .Cells(1, 1).CurrentRegion
End With
The area referenced by the above code can be demonstrated by selecting A1 and tapping Ctrl+A once (twice is A1:XFD1048576). The cells selected will be a rectangle encompassing the last column with data and the last row with data as the extents. Previously used cells and cells that have retained formatting from previous reports have no effect; only cell values and formulas. However, it must be emphasized that the island of data stops at the first fully blank row or column.
The last method I will mention is to position in (aka .Select or otherwise start at) A1 and use .Find with a wildcard searching backwards so that it ends up starting at XFD1048576 and searching toward A1 for the first value or formula it can find first by row then repeated by column.
Dim lr As Long, lc As Long, rng As Range
With Sheets("Sheet3")
lr = .Cells.Find(What:=Chr(42), After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lc = .Cells.Find(What:=Chr(42), After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set rng = .Cells(1, 1).Resize(lr, lc)
End With
This is really the only true method of getting an accurate representation of your data block but its thoroughness is not usually necessary.

Sub highlight()
Dim obj As Range
For Each obj In Sheet1.UsedRange
If obj.Value = Range("A1").Value Then
obj.Interior.Color = vbYellow
Else
obj.Interior.Color = vbWhite
End If
Next obj
End Sub

Related

Copying columns including blanks without skipping rows..leave "blanks" blank VBA

Aplication Defined error Copying a specified column and range including blanks with an embedded button running multiple Macros. I know that all rows will be filled in column A so if I could reference the rest of the Macros to A.end
I've looked Google youtube and here although there is a lot of info on copying and pasting, I cannot find one that works for this running multiple Macros.
Macros 5 & 6 is where I start having problems because these columns have multiple blanks throughout.
Raw data to Copy:
Destination:
Private Sub CommandButton1_Click()
Worksheets("Sheet1").Range("a2", Range("a2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("a2") 'macro1
Worksheets("Sheet1").Range("d2", Range("d2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("b2") 'Macro2
Worksheets("Sheet1").Range("c2", Range("c2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("c2") 'macro3
Worksheets("Sheet1").Range("g2", Range("g2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("d2") 'macro4
If Worksheets("Sheet1").Range("e2", Range("e2").End(xlDown)).Value = "<0" Then
Worksheets("Sheet2").Range("i2").Copy 'macro5
If Worksheets("Sheet1").Range("e2", Range("e2").End(xlDown)).Value = ">0" Then
Worksheets("Sheet2").Range("j2").Copy 'macro6
Worksheets("Sheet2").Activate 'macro7
Range.end(xldown) only gets you a contiguous range (effectively it will stop at the first blank cell).
Since you want to include blanks, you might want to instead work from the last row of your worksheet back up to the first non-blank cell encountered in that column (which is a way of getting the last row).
This would mean something like:
' If you are new to With statements (below), any objects within the With block that begin with a . relate to "Sheet1". Saves us typing Sheet1 repeatedly, and makes sense to use it since we access a lot of Sheet1's members like range/cells/rows
With Worksheets("Sheet1")
.Range("a2", .cells(.rows.count, "A").End(xlup)).Copy Worksheets("Sheet2").Range("a2") 'macro1
End with
Untested, written on mobile -- but hope it works or gets you closer to a solution. You would need to copy-paste the above and change the A to B, C, D, E, etc. I wasn't too sure what you're trying to achieve with the "<0" condition in macro 5 and 6.
(It would better if you turned the code into a parameterised Sub and just provide the column letter/number as an argument to the sub, but just depends how new you are to VBA and programming in general -- and for the time being whatever is easier for you to understand/maintain.)
Edit regarding macro 5 and 6
With Worksheets("Sheet1")
Dim cell as range
For each cell in .Range("E2", .Cells(.Rows.Count, "E").End(xlUp))
If cell.Value <= 0 Then 'Get rid of the equal sign if you don't want it in your logic/condition'
Cell.Copy Worksheets("Sheet2").cells(cell.row, "I") 'Macro5
ElseIf cell.value > 0 Then
Cell.Copy Worksheets("Sheet2").cells(cell.row, "J") 'Macro6
End If
Next cell
End With
Worksheets("Sheet2").Activate 'macro7

Making an excel VBA macro to change dates and format

I'm a complete novice at macros but I've had trouble finding the exact solutions I need, and more trouble combining them. I get this raw data report which needs a couple of changes before I can input it into our master data set for reporting. These things need to happen (please refer to the picture):
The date needs to be expressed in the formation "mmm-yy". I've tried to add "01/" to make "01/04/2017" (I'm Australian so this is the 1st of April), but for some reason it automatically changes it to 04/01/2017. Ultimately, I need 04/2017 to go to Apr-17 for all data in the column
"Medical Div" change to "Medical" and "Mental Health Div" change to "Mental Health" - i've already sorted a macro for this, but not sure how to combine it with another macro for the other functions I'm wanting.
If anyone can help providing code or links to good resources which will allow me to perform all these functions at once with one macro that would be great.
Thanks
This can easily be done with Power Query instead of VBA. Power Query is a free add-in from Microsoft for Excel 2010 and 2013 and built into Excel 2016 as "Get and Transform". Conceptually, the steps are:
Load the data
insert a new column with a formula that combines the text "1/" with the column Month-Year
change the type of the new column to Date
remove the old Month-Year column
select the Division column
replace " Div" with nothing
Save the query
When new data gets added to the original data source, just refresh the query. All this can be achieved by clicking icons and buttons in the user interface. No coding required.
Well, for point 2, how about recording a macro and using Find and Replace twice?
This should combine them into a macro for you. Then you can copy paste that elsewhere.
As for the date, Excel has an predisposition to convert to US format. Try this first (assuming "Month-Year" column is B)
Range("B2") = DateValue(Range("B2"))
Then apply formatting later.
Private Sub mySub()
Dim myRng As Range
Dim r As Range
Dim LastRow As Long
Dim mySheet As Worksheet
Dim myFind1, myFind2 As Variant
Dim myReplace1, myReplace2 As Variant
'This will get the number of rows with value in the sheet
LastRow = Sheets("Sheet1").UsedRange.Rows.Count
'This is for the first find and replace. It will search all cells with exact value of "Medical Div" in the sheet and change it to "Medical".
myFind1 = "Medical Div"
myReplace1 = "Medical"
'This is for the second find and replace. It will search all cells with exact value of "Mental Health Div" in the sheet and change it to "Mental Health".
myFind2 = "Mental Health Div"
myReplace2 = "Mental Health"
'This will loop through the entire column with the date that needs to have the format mmm-yy. It will convert the 04/2017 to date format first before making it Apr-17.
With Sheets("Sheet1")
Set myRng = Sheets("Sheet1").Range("A2:A" & LastRow)
For Each r In myRng
r.Value = CDate(r.Value)
Next r
End With
myRng.NumberFormat = "mmm-yy"
'This will loop through the active worksheet and apply the find and replace declared above.
For Each mySheet In ActiveWorkbook.Worksheets
mySheet.Cells.Replace what:=myFind1, Replacement:=myReplace1, _
LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
mySheet.Cells.Replace what:=myFind2, Replacement:=myReplace2, _
LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next mySheet
End Sub
Here is a code that you could try.
It will change the date format of the column with Month-Year to
"Apr-17" regardless of the current date format.
It will also find and replace the Medical Div and Mental Health Div
to "Medical" and "Mental Health".
You will need to change the range to suit your needs. I have set the column for the month-year to column A. You must change it to column B if that is where your dates are.
This is my data before running the macro:
Here is my data after running the macro:

Compare Cell Data and Copy

I found this great snip of code and I am trying to manipulate it to work for me, but I just can't seem to get it. Unfortunately I haven't been able to get my head around it to fully understand it, which doesn't help. So I turn to you. I need to evaluate a column of cells and look for either similarities or differences. If a cell in sheet 1 column 1 is not the same as any of the cells in sheet 2 column 1, I want to copy the entire row into sheet 1 at the bottom of the used area. I've gotten this to the point where what you see will copy the correct first cell, but I can't manipulate it to copy the entire row. I think because of how the 'With' is structured but I need to try to stay away from doing loops since there is over 30k cells to evaluate.
Going down the road I will also be wanting to look for duplicates using the same method above, and if there is a duplicate, compare the adjacent cells for differences and if there is a difference, move the existing data into a comment and move the new data into the existing cell.
Any and all advice is, as always, very appreciated.
Sub Compare_Function()
Call Get_Master_Cell_Info
Application.ScreenUpdating = False
With Sheets("Update").Range(Cells(4, 1), Cells(Rows.Count, 1).End(xlUp)).Offset(, 1)
.Formula = "=VLOOKUP(A4,'New Master Data 6.1'!A:A,1,FALSE)"
.Value = .Value
.SpecialCells(xlCellTypeConstants, 16).Offset(, -1).Copy Sheets("New Master Data 6.1").Range("A" & Rows.Count).End(xlUp).Offset(1)
.ClearContents
End With
Application.ScreenUpdating = True
End Sub
Quick line by line breakdown
This just takes the entire used range from cells A4 to the last used cell in columnA then offsets it by one column so B4:Bx (x is the last used row in column A)
With Sheets("Update").Range(Cells(4, 1), Cells(Rows.Count, 1).End(xlUp)).Offset(, 1)
This puts the formula in all cells so it looks up A4,A5,A6, etc in master sheet, returns the value in the master sheet or an error if its not found. It then copies the values over so they are hardcoded in
.Formula = "=VLOOKUP(A4,'New Master Data 6.1'!A:A,1,FALSE)"
.Value = .Value
Specialcells looks for constants (all cells) and value 16 which means error cells (ie cells don't exist) offsets by -1 (so column A) and copies to new sheet column A at rows.count+1
.SpecialCells(xlCellTypeConstants, 16).Offset(, -1).Copy Sheets("New Master Data 6.1").Range("A" & Rows.Count).End(xlUp).Offset(1)
You might also want to do this after you .clearcontents so you don't get all the error cells in column B
to fix it just change the copied range to .entirerow so
.SpecialCells(xlCellTypeConstants, 16).entirerow.Copy Sheets("New Master Data 6.1").Range("A" & Rows.Count).End(xlUp).Offset(1)
You will also copy the errors in column B but with this structure there is no getting around that. Can always erase them from the master sheet after.
Also note this code will overwrite any data you have stored in column B.
One more note this code depends on the sheet update being active, it won't run otherwise since your cells function inside your range needs the worksheet explicitly stated, as does your rows.count. You would be better wrapping the whole thing in 2 withs, one for the sheet and one with the range (using .cells and .rows.counmt)

Replace Cell with Header Cell

I'm trying to figure out how to either substitute or replace a cell's data with existing data from a header cell.
In the most succinct way to describe it:
If cell = 'unchecked', then replace with the cell's header cell.
There are numerous columns so I can't specifically say replace with a specific cell for all. It would vary depending on the cell.
As in: (not code but won't let me save request without indentation.)
C3=unchecked, then pull C1.
H18=unchecked, then pull H1.
P4=unchecked, then pull P1.
Just cycle through the columns, replacing the term "unchecked" with the value found in the first row of that column.
dim c as long, rplc as string
rplc = "unchecked"
with activesheet
with .cells(1, 1).currentregion
for c = 1 to .columns.count
with .columns(c)
.replace what:=rplc, replacement:=.cells(1, 1).value2, _
lookat:=xlwhole, matchcase:=false
end with
next c
end with
end with
This is a generic framework and is intended to give you something to get started with. Transcribe it for your own purposes and use debug (e.g. F8) to walk through the code to make sure it is doing what you want. If you run into trouble, come back and explain what you do not understand, what errors are occurring and what you have discovered through debug.
You will want to change the ActiveSheet property reference to an actual worksheet name.

How to delete rows that had formulas before value paste?

I got an spread sheet that include formulas and I wrote a vb code to value paste.
Depending on the input file number of rows that filled is varied and I need to delete the rows those had formulas and now empty. (This is using as connector and otherwise it some how pick these extra rows which is unnecessary)
Sheet2.Range("G2:G298").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Above code not doing anything...
If the blanks are results of a formula like:
=""
Entered into a cell and then copied and paste as values, those are not really blank cells.
Instead, those are cells that looks blank but contains zero length strings.
SpecialCells(xlCellTypeBlanks) and even Excel formula ISBLANK won't work on it.
One way is to loop through the range and check all that contains "" and delete it.
Dim c As Range, rngtodelete As Range
For Each c In Sheet2.Range("G2:G298")
If Len(c.Value) = 0 Then
If rngtodelete Is Nothing Then Set rngtodelete = c _
Else Set rngtodelete = Union(rngtodelete, c)
End If
Next
If Not rngtodelete Is Nothing Then rngtodelete.EntireRow.Delete xlUp
Another way is using AutoFilter like this:
Sheet2.Range("G2:G298").AutoFilter 1, "="
Sheet2.Range("G2:G298").SpecialCells(xlCellTypeVisible).EntireRow.Delete xlUp
I'm assuming that G2 does not contain your header but the start of your data.
If it happens to be your header, you'll need to use offset when deleting.
Sheet2.Range("G2:G298").Offset(1, 0) _
.SpecialCells(xlCellTypeVisible).EntireRow.Delete xlUp
Sheet2.AutoFilterMode = False
I'm not completely sure what you mean by "This is using as connector", but I believe it has to do with an export/import process to another application.
As mentioned, a zero length string is not the same as a truly blank cell. However, you can rid your worksheet of them easily. The fastest method I am aware of is a quick cyclic run through all of the columns, applying Text-to-Columns ► Fixed width ► Finish to each.
When that is done, the zero length strings will be reverted to truly blank cells but the worksheet's used range will still overlap those empty cells found at the bottom of the dataset. This means that any export to an external program will try to export those cells. Just run .UsedRange to get Excel to reevaluate the actual used range.
First, tap Ctrl+End to see what Excel thinks is the last used cell on the worksheet. Next, run the following macro.
Sub prep_for_export()
Dim c As Long
Debug.Print Sheets("Sheet1").UsedRange.Address(0, 0)
With Sheets("Sheet1")
For c = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
.Columns(c).TextToColumns Destination:=.Cells(1, c), _
DataType:=xlFixedWidth, FieldInfo:=Array(0, 1)
Next c
End With
Sheets("Sheet1").UsedRange
Debug.Print Sheets("Sheet1").UsedRange.Address(0, 0)
End Sub
Edit Sheet1 in all four places if you have to before running it.
That is a little homogeneous but I think it should work for your purposes. After running the macro, tap Ctrl+End back at your worksheet again to see what Excel thinks is the last used cell on your worksheet. The before and after range addresses were recorded to the VBE's Immediate window as well.