Not a VBA expert at all and would really appreciate any help you experts could offer. I have a spread sheet with 10 columns (A-J) and a "control" column (M). Rows of data will be populated beginning with Row 9, with Row 8 being the header row. Row 7 contains specific formatting to be applied to rows if criteria in column M is met. For several reasons, I need to use VBA rather than conditional formatting. The code I have almost works. It worked on the initial row that met the criteria but none of the subsequent rows. Tried to fix the issue and now none of it works.
The specifics of my current code are:
rngSheet - the area of my spreadsheet with data that needs to be formatted.
rngColorTrigger - Column M containing the criteria. Criteria trigger is if the column value is 0.
rngColor - the cells containing the format to be copied and pasted (Row 7).
My current very-bad-doesn't-work code:
Private Sub Worksheet_SelectionChange2(ByVal Target As Range)
Dim rngColor As Range
Dim rngSheet As Range
Dim rngColorTrigger As Range
Set rngColor = Sheet1.Range("rngColor")
Set rngSheet = Sheet1.Range("rngSheet")
Set rngColorTrigger = Sheet1.Range("rngColorTrigger")
' Limit the copy area to the range for which the trigger is entered
If Not Intersect(Target, Sheet1.Range("rngColorTrigger")) Is Nothing Then
' Only trigger if the value entered is valid (Cell in Column M = 0)
For Each cell In Range("rngColorTrigger")
If cell.Value = 0 Then
Sheet1.Range("rngColor").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheet1.Range("rngSheet").Select
Selection.PasteSpecial Paste:=xlPasteFormats
End If
Next cell
' Reset EnableEvents
Application.EnableEvents = True
End If
End Sub
I have very similar code that copy, cuts, and pastes content between pages based on a valid date being entered in a control column and it works fine...
Related
I have a list of query words that I am submitting to a database (Column A) to generate a list of coded matches (Columns F-H). Column F is the original search word (so there is an exact match somewhere in Column A), Column G contains the match, and Column H contains the code for the match. What I need to do is take the query word in Column F and find its partner in Column A. Then I need to take the corresponding match and its code and paste it next to the original search term in Column A (in Columns B&C).
My problem here is getting the information pasted in the correct cell since the copy to and paste from locations change every time -- The list of coded matches in Columns F-H does NOT contain all of the terms in Column A.
I've been searching the internet and I can't seem to figure out what exactly I need to change to allow the paste function to work.
I have attached an image of a simplified version of my spreadsheet and a annotated version of the code I have been working with.
Sub FindMatch()
LastRow = Cells(Rows.Count, 6).End(xlUp).Row
For i = 1 To LastRow
FindMe = Cells(i, 6).Value
Set FoundinList = Cells.Find(What:=FindMe, After:=ActiveCell, LookAt:=xlWhole)
If Not FoundinList Is Nothing Then
FoundinList.Select
ActiveCell.Offset(0, 1).Select
'At this point the cell I want the information pasted into is selected. Yay!
'Example: I am trying to find "abnormal digits" (F1) in Column A and paste
'G1:H1 into the appropriate cells in Columns B & C (In this case B15:C15)
'At this point in the code my cursor is on cell B15 - which is where I need it.
Range(Cells(i, 7), Cells(i, 8)).Copy
'This selects the appropriate range (G1:H1 in my example).
ActiveCell.Paste
'This is the problem string. I've tried naming the "ActiveCell" before initiating the copy
'string (ActiveCell.Name = "PasteHere") and then pasting into the named cell
'(Cells("PasteHere").Paste), but that gives me an invalid procedure call or argument on:
'Cells("PasteHere").Paste I've also tried pasting into a range:Range(Cells(PasteHere, 2)
', Cells(PasteHere, 3)).Paste -AND- using the formula that is created when you a record a
'macro (Application.CutCopyMode = False) but both of those give me an application
'/object-defined error.
End If
Next i
End sub
Thank you so much in advance for reading this post and helping me out.
My Spreadsheet
End Product
This vba uses the worksheet function vlookup.
Sub ahhn()
Dim ws As Worksheet
Dim cel As Range
Set ws = ActiveSheet
With ws
For Each cel In .Range(.Range("A1"), .Range("A1").End(xlDown))
cel.Offset(0, 1) = WorksheetFunction.IfError(Application.VLookup(cel, .Range("F:H"), 2, 0), "")
cel.Offset(0, 2) = WorksheetFunction.IfError(Application.VLookup(cel, .Range("F:H"), 3, 0), "")
Next
End With
End Sub
I am running a macro, that asks for a sheet name and a reference cell, and then selects a range of cells, surrounding the cell of our choice.
After applying a filter to my data, some of the rows become hidden, as they are not needed.
The problem is, that the macro does not take that into consideration and counts the hidden rows too.
Here is the code, that I use in the original version of the macro:
.....after applying some InputBox and a search for the user's value, the following row is executed:
Range(ActiveCell.Offset(90, 0), ActiveCell.Offset(-252, 2)).Select
Selection.Copy
In this way hidden rows are included in the selection.
I tried the following modification
Range(ActiveCell.Offset(90, 0), ActiveCell.Offset(-252, 2)).SpecialCells(xlCellTypeVisible).Select
Selection.Copy
However without success.
I was wondering, can anyone suggest a way to use ActiveCell.Offset in combination with SpecialCells(xlCellTypeVisible) resulting in the above described functionality of the macro -namely to select a range of cells avoiding the hidden rows after filtering?
To select just the visible cells from a range of selected cells, you can use the following line of code:
Selection.SpecialCells(xlCellTypeVisible).Select
Like in this Example:
Range(ActiveCell.Offset(90, 0), ActiveCell.Offset(-252, 2)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
The Code Below is a example on how you could count the Rows.
So but there is a Problem where you have to think about.
If You Paste the Selection to your Original Sheet, there is a Chance that there are Hidden Rows in the area where you Copied the Selection.
If this is so, The Text which you copied there will be Hidden too.
So you have to Copied the Data to a new Sheet to avoid that Problem or you have to Copied the Data at the bottom of the Sheet 1.
Option Explicit
'Define a Constant for the Amount of Rows you Need
Private Const ConstAmountRows As Integer = 40
Sub Test()
Dim intCountedRows As Integer
Dim idx As Integer
Dim intDifference As Integer
idx = 0
Do
If Not (intCountedRows = ConstAmountRows) Then
intCountedRows = ConstAmountRows
idx = idx + 1
End If
Sheets("Sheet1").Select
'Select the Range with the Amount of Rows you need ideally
Range("A1:A" & intCountedRows + idx).Select
'Select only the Visible Cells
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Sheet2").Select 'Select another Sheet
'***-> Her you can select the Place you want to Paste the Text<-***
Range("B1").Select
ActiveSheet.Paste
'*** Count the Rows that you Paste
intCountedRows = Selection.Rows.Count
'if the Counted Rows are not equal to the Amount. Repeat
Loop While Not (intCountedRows >= ConstAmountRows)
End Sub
I am trying to count the number of occurrences of a specific string in filtered data. I can do it using a formula in a cell but when I combine that with the other macros in my workbook the whole thing freezes.
So I would like to move the calculation to VBA so that it only calculates when the macro is run. Here is the formula that works in the cell:
=SUMPRODUCT(SUBTOTAL(3,OFFSET('2015 Master'!H:H,ROW('2015 Master'!H:H)-MIN(ROW('2015 Master'!H:H)),,1)),ISNUMBER(SEARCH("*Temp*",'2015 Master'!H:H))+0)
Basically I want to count the number of times "Temp" occurs in column H but only in the filtered data.
Thank you for your help!
ADDITION:
Here is the code I've written for the macro so far. It filters the data on a different sheet then updates the pivot table with the date range. I would like to add the count calculations to the end of this code and return the count to a cell on the 'Reporting' sheet.
Sub Button1_Click()
'Refresh the pivot table and all calculations in the active sheet
ActiveWorkbook.RefreshAll
'Gather the start and end times from the active sheet
dStart = Cells(2, 5).Value
dEnd = Cells(3, 5).Value
'Change the active sheet to the alarms database, clear all filters and then filter for the defined date range and filter for only GMP alarms
Sheets("2015 Master").Select
If ActiveWorkbook.ActiveSheet.FilterMode Or ActiveWorkbook.ActiveSheet.AutoFilterMode Then
ActiveWorkbook.ActiveSheet.ShowAllData
End If
ActiveSheet.ListObjects("Table44").Range.AutoFilter Field _
:=3, Criteria1:=">=" & dStart, Operator:=xlAnd, Criteria2:= _
"<=" & dEnd
Range("Table44[[#Headers],[GMP or non-GMP]]").Select
ActiveSheet.ListObjects("Table44").Range.AutoFilter Field:=2, Criteria1:= _
"GMP"
'Change the active sheet to the Reporting sheet
Sheets("Reporting").Select
'Within the alarms pivot table clear the label filters then filter for the date range and GMP alarms
ActiveSheet.PivotTables("PivotTable1").PivotFields("Active Time"). _
ClearLabelFilters
ActiveSheet.PivotTables("PivotTable1").PivotFields("Active Time").PivotFilters. _
Add Type:=xlDateBetween, Value1:=dStart, Value2:=dEnd
ActiveSheet.PivotTables("PivotTable1").PivotFields("GMP or non-GMP"). _
CurrentPage = "GMP"
End Sub
Pertinent to clarified question topic (i.e. " Basically I want to count the number of times "Temp" occurs in column H..."), the VBA solution can be as shown in the following code snippet. Assuming sample data entered in Column "H":
H
Temp Directory on C: Drive
Temp Directory
Project Directory
Output Temp Directory
Start Directory
Temp obj
apply the VBA Macro:
Sub CountTempDemo()
Dim i As Integer
Dim count As Integer
Dim startRow As Integer
Dim lastRow As Integer
Dim s As String
startRow = 2 'or use your "filtered range"
lastRow = Cells(Rows.count, "H").End(xlUp).Row 'or use your "filtered range"
count = 0
For i = 2 To lastRow
If InStr(Cells(i, 8).Value, "Temp") > 0 Then
count = count + 1
End If
Next
End Sub
where count value of 4 is a number of "Temp" occurrences in specified "H" range.
Hope this may help. Best regards,
To iterate over a column and find only visible (unfiltered) cells, one way is this:
Set h = ... Columns ("H");
Set r = h.SpecialCells(xlCellTypeVisible)
' now r is a composite range of potentially discontiguous cells
' -- it is composed of zero or more areas
'but only the visible cells; all hidden cells are skipped
Set ar = r.Areas
for ac = 1 to ar.Count
Set rSub = ar(ac)
'rSub is a contiguous range
'you can use a standard formula, e.g. Application.WorksheetFunction.CountIf(...)
'or loop over individual elements
'and count what you like
next
caveats: if any rows (or the column) are hidden manually (not from filtering) the count using this method will consider them as filtered (i.e. hidden/not visible).
Update: answer to comment
A Range is really a very general purpose notion of an aggregation of cells into a grouping or collecting object (the Range). Even though we usually think of a Range as being a box or rectangle of cells (i.e. contiguous cells), a Range can actually assemble discontiguous cells.
One example is when the user selects several discontiguous cells, rows, and/or columns. Then, for example, ActiveSheet.Selection will be a single Range reflecting these discontiguous cells. The same can happen with the return value from SpecialCells.
So, the Excel object model says that in general, a Range can be composed of Areas, where each Area itself is also represented by a Range, but this time, it is understood to be a contiguous Range. The only way you can tell if the Range is contiguous or not is if you created it as a box/rectangle, or, if Areas.Count = 1.
One way to investigate a bit more might be to select some discontiguous cells, then enter a macro and use the debugger to observe Selection.
I need to have the user select a range of cells with their mouse and then run a macro to add +1 to that selected range. The range will often be different every time, so it cannot be defined.
Here's what I have so far, it just works on a single active cell, I cannot get it to work on a range selection, because I do not know what to define or function to utilize.
My code Follows:
Sub Add()
ActiveCell.Value = ActiveCell.Value + 1
End Sub
The below code uses the built-in Paste Special Add feature to add 1 to every cell in the selected range.
Sub AddOneToSelection()
Dim rBlank As Range
If TypeName(Selection) = "Range" Then
'Put a '1' in an unused cell and copy it
Set rBlank = ActiveSheet.Cells.SpecialCells(xlLastCell).Offset(1, 0)
rBlank.Value = 1
rBlank.Copy
'Paste Special Add over the selection
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlAdd
'Get rid of the copied cell
rBlank.ClearContents
End If
End Sub
The benefit of this over looping is that Paste Special Add treats formulas and values differently and you don't have to code that part yourself.
The downside is you increase your UsedRange by one row, if that matters to you.
This should work for you:
Dim r, c As Range
Set r = Selection
For Each c In r
c.Value = "+1"
Next
This assumes that your cell formats will display "+1" instead of "1". You can set the format of your cells to "Text".
I'm new to VBA, I'm using Microsoft Office Excel 2007 and I read the forums but this seems impossible for me. I have the current code which copies a sheet and adds a day to the date and also copies a range of cells containing the important information from the sheet to be able to paste it in a calendar with realtime information and I need it to paste where the date is the same and one cell below the value which could be located in any place in a certain range.
Sub CopierPetete()
ActiveWorkbook.ActiveSheet.Copy _
After:=ActiveSheet
'update date
[J1].Value = [J1].Value + 1
'THIS IS MY POOR ATTEMPT TO MAKE IT WORK
If Sheets("Sheet5").Range("A1:K100").Value = ActiveSheet.Range("J1").Value Then _
ActiveSheet.Range("AA100:AC121").Select
Selection.Copy
Sheets("Sheet5").Select
Sheets("Sheet5").Pictures.Paste Link:=True
End If
End Sub
I need it to match the value in the ActiveAheet cell J1 with any cell on Sheet5, and paste as Pictures.Paste Link=True (or, if you have a better idea for a way to display real-time information) at the place where the value is met on Sheet5, one cell below.
Here's a link to the project!
If I understand well, what you intend to do is to check if the value of the ActiveSheet > cell J1 exists in the Sheet named "Sheet5" within the range A1 to K100. Meaninly, if Excel finds any cell withing A1 to K100 matching the J1 value, copy-paste the picture.
Here is a try:
Sub CopierPetete()
Dim rFind as Range
ActiveWorkbook.ActiveSheet.Copy _
After:=ActiveSheet
'update date
[J1].Value = [J1].Value + 1
'Find returns a range object, so we use Set
Set rFind = Worksheets("Sheet5").Range("A1:K100").Find(ActiveSheet.Range("J1").Value, LookIn:=xlValues, lookAt:=xlWhole)
If Not rFind is Nothing Then
ActiveSheet.Range("AA100:AC121").Copy
Worksheets("Sheet5").Activate
Worksheets("Sheet5").Range(rFind.Address).Offset(0, 1).Activate
Worksheets("Sheet5").Pictures.Paste Link:=True
End If
End Sub