I'm pretty new to VBA and am trying to see if I can create a code for a certain process. I have a spreadsheet with a few unique identifiers and company names in the first row (Company A, Company B, etc). In the following columns, there are a few other columns such as location, key contact, etc, that correspond to each company. Lastly, there is a column for "comments". These comments get updated fairly regularly.
What I'm trying to do is create a macro that will allow me to find the comment for the unique company, copy (or cut) it and paste it in a "historical comments" sheet in the same workbook, so that I can maintain a record of the past comments. Is there a way to create a macro to do this? I've created something that, if i put in the exact Cell Name , it will copy that comment and paste it but I wanted to see if I could designate one cell where I could type in the Company Name, and the macro would look at what is in that cell and then copy the corresponding comment, paste it in the back sheet, and then clear the cell so that I can input a new comment. I have no idea if this is even remotely possible, but any help would be greatly appreciated!
Sub Range_copy()
Dim cellwant As Variant
Dim cellhistory As Variant
Dim LRow As Variant
Dim Account As Variant
Worksheets("AAG").Select
Worksheets("AAG").Range("I3").Select
cellwant = Selection.Value
FindString = Sheets("AAG").Range("B5:B65").Value
cellwant = Selection.Value
Worksheets("AAG").Range(cellwant).copy
Worksheets("Sheet2").Activate
Worksheets("Sheet2").Range("A1").Select
The question's a little vague about what a 'corresponding comment' would be for a company name. However, I think what you're looking for could be done using the Worksheet_Change event, which will trigger automatically whenever a change is made on a given worksheet.
Private Sub Worksheet_Change(ByVal Target As Range)
Const csCommentCol As Integer = 5 'The column that contains the comments
Const csTarget As String = "Sheet2" 'The worksheet with the record of comments
Const csTargetCol As String = "A" 'The column on the sheet with the list
Dim shtTarget As Worksheet
Dim lngLast As Long
Dim strOldComment As String
Dim strNewComment As String
Application.EnableEvents = False 'Prevent this procedure from triggering repeatedly
If Target.Column = csCommentCol Then 'Check if it's the comment column that's being changed
Set shtTarget = Sheets(csTarget) 'Define our target sheet. Only here for clarity later
lngLast = shtTarget.Range(csTargetCol & Rows.Count).End(xlUp).Row + 1 'Find the first empty row
strNewComment = Target.Value 'Copy the newly entered comment into a variable for safekeeping
Application.Undo 'Undo the change to return to the old value
strOldComment = Target.Value 'Copy the old value into a string for future use
Target.Value = strNewComment 'Restore the new comment
shtTarget.Range(csTargetCol & lngLast).Value = Target.Value 'Copy the value over
Target.Select
End If
Application.EnableEvents = True
End Sub
Put this code in the Sheet object (not a module) of the worksheet that will contain the comments. Replace the constants at the top as needed. It will automatically run every time a change is made; it checks to see if the change is being made in our specified column (that can be a specified cell if you wish); if the change is there, it finds the first empty cell in our record sheet and duplicates the value in the cell over there; then it clears the target cell for a new entry and reselects it.
Related
I have a workbook which has a Summary Sheet and updates with new sheets (with changing names, imported from a specified path) upon command. In the summary sheet, I want to collect specific information present in the other sheets (all of them have the same template filled in with different information).
For example, I want to copy the merged ranges B3:O3 in Sheet X, Sheet Y and Sheet Z into Cells A2, B2, C2 in Summary Sheet.
Questions:
A) How do I copy the info?
B) How do I link the command to existing "Refresh Sheets" command which populates the workbook with updated information from a specified folder?
Relatively new to VBA, so excuse me if question is basic. Thanks!
Assuming B3:O3 is a merged range you take the top left cell from each. Sub RefreshSheets represents your existing command and then there is a call within that code to the new sub GetInfo.
Like this
Option Explicit
Public Sub RefreshSheets()
'Your current refresh code
GetInfo 'call to other sub
End Sub
Public Sub GetInfo()
Dim wb As Workbook
Set wb = ThisWorkbook
With wb.Worksheets("Summary Sheet")
.Range("A2") = wb.Worksheets("X").Range("B3")
.Range("B2") = wb.Worksheets("Y").Range("B3")
.Range("C2") = wb.Worksheets("Z").Range("B3")
End With
End Sub
If working with variable sheet names you could assign by position e.g.
Sheets(Sheets.Count)
Or use a variable
Dim X As String
X = "X"
Sheets(X)
Overview
I'm trying to lock cells within a named range that have visible conditional formatting. The 3 linked images below will illustrate my constraints:
Name range: table (cells C1:E6) is set to be conditionally formatted with a blue fill color.
This is the conditional format fill color (color index #: 37) being used.
The row will change to the blue fill if criteria in column A is met, i.e. if the corresponding row in column A has the letter "f" as input.
In summary, I'm trying to lock the rows with the visible blue fill within the named range as well as the rest of the worksheet. And, I only want to edit cells within the named range that don't have the visible blue fill conditional format.
My Solution (so far)...
This macro creates the named range mentioned above and used in LockCells() macro (which is below this code snippet):
Sub NameRange()
'Create named range
Dim rng As Range
Dim range_name As String
Dim cells As String
Dim wkst As String
'Target worksheet
wkst = "Sheet1"
'Range of cells
range_name = "table"
cells = "C1:E6"
'Creates named range
Set rng = Worksheets(wkst).Range(cells)
ThisWorkbook.Names.Add Name:=range_name, RefersTo:=rng
End Sub
This macro loops through cells in named range (table) and attempts to lock the visible blue conditional formatted rows in named range:
Sub LockCells()
'Loop through cells in a given named range
'and lock cells based on blue fill color
Dim cell As Range
Dim color_index As Integer
'Target fill color
color_index = 37
'Target worksheet to protect
wkst = "Sheet1"
'Loop through cells in named range
For Each cell In Range("table")
Dim color As Long
color = cell.FormatConditions(1).Interior.ColorIndex
If (color = color_index) Then
cell.Locked = False
Else
cell.Locked = True
End If
Next
Sets protection for worksheet
Worksheets(wkst).Protect
End Sub
Problem
I'm stuck because instead of locking the visible blue filled cells, and keeping the other cells unlocked for editing, in the named range table it locks all of cells. Mind you, I do want the rest of the worksheet outside of the named range to be locked and protected. I know it's because the conditional format is applied to the named range and evaluating as true. Which is why it locks all cells in named range. My question about solving this issue is below.
Question
Is there state (or visibility) property for conditionally formatted cells?
I was thinking if there is such a property, I could use it in the if statement of my LockCells() macro. E.g. If (color = color_index) & [Conditional Format Visible] Then...
Your help would be much appreciated.
Thank you. :)
Here is a simplified example to work from. I have one format condition which happens to be Cell Value = 2 so I can refer to that rule via .FormatConditions(1) And as the rule is "=" I can use the comparison I have. You would want to adapt to the formula you are using.
Code:
Sub test()
Dim curr As Range
ActiveSheet.Cells.Locked = False
For Each curr In ActiveSheet.Range("C1:E6")
With curr.FormatConditions(1)
If curr.Value = Evaluate(.Formula1) Then curr.Locked = True
End With
Next curr
For Each curr In ActiveSheet.Range("C1:E6")
Debug.Print curr.Address & " locked = " & curr.Locked
Next curr
End Sub
Conditional format rule:
Sheet:
Reference:
http://www.excelfox.com/forum/showthread.php/338-Get-Displayed-Cell-Color-(whether-from-Conditional-Formatting-or-not)
I have a very complex workbook with many tabs. The tabs may have either normal data or formulas in various cells. In the case of formulas, the formulas may be nested from one sheet to the next (i.e. a formula on sheet1 refers to a formula on sheet2 which in turn refers to a formula on sheet3, etc.).
I have a hidden tab that contains the following: source sheet, source range, target sheet, and target range.
A named range has been created over these 4 fields and all applicable rows.
When we wish to save data to the database, we loop through every row in the range mapping and copy the data from the source sheet/range to the target sheet/range. After this, the applicable data is serialized into XML and sent to a web service to be saved.
The problem that we wish to resolve is that we want to mark a cell on a hidden sheet when a change is made by the user to a source range. Since formulas can be nested, the Worksheet_Change event does not pick up the change.
Since a change on one sheet may affect another sheet that is not the active sheet, the Workbook_SheetChange event does not catch the change either.
Is there any way form me to catch when a sheet defined in the mapping is changed, even if it is the result of a formula change several levels deep?
Edit
Thank you for your responses. I was attempting to find the fastest and least process intensive way to determine if data changes within a monitored range. The data may consist of actual data or of nested formulas.
My research showed that I could not actually achieve this result by taking range intersections as I could not detect if the data within a monitored range was modified. This is due to the fact that the monitored range may not be on the active sheet and also may contain formulas.
I have shown the method used to actually detect a change below. If there is any feedback on a better way to achieve the same result, I would appreciated it.
Worksheet_Change event will not work if a cell value is changed by a formula, you need Worksheet_Calculate.
Check out my example workbook here.
And Here for the WebPage of example codes
There is no "easy" way to detect if a nested formula has changed when the formula being monitored is not on the active sheet. While my hope was to detect the modified range and use an intersection of ranges to set a flag, this was not possible because the Worksheet_Change event does not work on formulas and the Workbook_SheetChange event only works on the active sheet. Since my workbooks have over 20+ tabs and 20 - 30 ranges being monitored, this approach does not work. This approach was desired for speed purposes.
Instead, the workbook will need to "check" to see if the current values are the same as the last time the save to database event was called. If not, a dirty flag will be set.
The code for this approach is provided below.
An example of the mapping range is shown in the picture below though in practice there are 20-30 rows comprising this range.
There are three other sheets where Sheet3 contains actual data in A1:H1 and Sheet2 has formulas pointing to Sheet3. Sheet1 has formulas pointing to Sheet2.
As the mapping range indicates, we are looking at a range on Sheet1, even though changes may be made to Sheet3.
The code used is as provided below.
Option Explicit
Public Sub DetermineIfEditOccurred()
Dim oMappingRange As Range
Dim szSourceTab As String
Dim szSourceRange As String
Dim oSourceRange As Range
Dim szTargetTab As String
Dim szTargetRange As String
Dim oTargetRange As Range
Dim oWorksheetSource As Worksheet
Dim oWorksheetTarget As Worksheet
Dim oRangeIntersection As Range
Dim nRowCounter As Long
Dim nCellCounter As Long
Dim szSourceValue As String
Dim szTargetValue As String
Dim oCell As Range
Dim bIsDirty As Boolean
If Range(ThisWorkbook.Names("DirtyFlag")).Value = 0 Then
Set oMappingRange = Range(ThisWorkbook.Names("Mapping"))
For nRowCounter = 1 To oMappingRange.Rows.Count
szSourceTab = oMappingRange(nRowCounter, 1)
szSourceRange = oMappingRange(nRowCounter, 2)
szTargetTab = oMappingRange(nRowCounter, 3)
szTargetRange = oMappingRange(nRowCounter, 4)
Set oWorksheetSource = ThisWorkbook.Worksheets(szSourceTab)
Set oWorksheetTarget = ThisWorkbook.Worksheets(szTargetTab)
Set oSourceRange = oWorksheetSource.Range(szSourceRange)
Set oTargetRange = oWorksheetTarget.Range(szTargetRange)
nCellCounter = 1
For Each oCell In oSourceRange.Cells
szSourceValue = oCell.Value
If szSourceValue = "#NULL!" Or _
szSourceValue = "#DIV/0!" Or _
szSourceValue = "#VALUE!" Or _
szSourceValue = "#REF!" Or _
szSourceValue = "#NAME?" Or _
szSourceValue = "#NUM!" Or _
szSourceValue = "#N/A" Then
szSourceValue = ""
End If
szTargetValue = GetCellValueByPosition(oTargetRange, nCellCounter)
If szSourceValue <> szTargetValue Then
Range(ThisWorkbook.Names("DirtyFlag")).Value = 1
bIsDirty = True
Exit For
End If
nCellCounter = nCellCounter + 1
Next
If bIsDirty Then
Exit For
End If
Next
End If
End Sub
Public Function GetCellValueByPosition(oRange As Range, nPosition As Long) As String
Dim oCell As Range
Dim nCounter As Long
Dim szValue As String
nCounter = 1
For Each oCell In oRange
If nCounter = nPosition Then
szValue = oCell.Value
Exit For
End If
nCounter = nCounter + 1
Next
GetCellValueByPosition = szValue
End Function
The Workbook_SheetChange event is as follows:
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call DetermineIfEditOccurred
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name <> "MAPPING" Then
Call DetermineIfEditOccurred
End If
End Sub
I'm using microsoft excel 2013.
So i have two sheets. "Cases" and "Summarize". All of my important info is on the Cases sheet. Is there way i can be on the "Summarize" sheet, push a button and copy all the cellrows with the value "RLH" from cases over to the summarize sheet?
I've filled the entire row up to N. And i want that entire row to be copied into the summarize sheet when I push the button. The "RLH" value is on the N(last) column.
I know how to create the button and how to insert the code. I've been googling my ass of, but I cant seem to find anything that fits me.
All help is greatly appreciated.
Here is very simple. that will get you started
assign to Button
Option Explicit
Sub Mybutton()
'// declare a variable
Dim cRng As Range
Dim rngA As Long
Dim rngB As Long
Dim Cols As Long
Dim sCases As Worksheet
Dim sSummarize As Worksheet
'// Set the sheets name
Set sCases = Sheets("Cases")
Set sSummarize = Sheets("Summarize")
'// goes through each cell in Sheets"Cases"
'// and copes the Value "RLH" to Sheets"Summarize"
'// it starts from last row in column A & looks up
rngA = sCases.Cells(Rows.Count, "N").End(xlUp).Row
Cols = sCases.UsedRange.Columns.Count
For Each cRng In sCases.Range("A2:A" & rngA)
If cRng.Value = "RLH" Then '<<<<<<<<< Value = "RLT"
rngB = sSummarize.Cells(Rows.Count, "A").End(xlUp).Row + 1
sSummarize.Range("A" & rngB).Resize(1, Cols) = cRng.Resize(1, Cols).Value
End If
'// loop
Next cRng
Set sSummarize = Nothing
Set sCases = Nothing
End Sub
hope this helps
you may also find help full on the following link MSDN Getting Started with VBA.
Right now I have a master excel workbook that employees use for data entry. Each of them downloads a copy to their desktops and then marks their progress on various entries by entering an "x" in a comlun next to the data they've finished. Each product has its own row with its respective data listed across that row. The master workbook is filled out throughout the quarter with new data for the products as it becomes available, which is currently updated on each individuals workbook by use of a macro that simply copies the range where the data is (see code below).
Sub GetDataFromClosedWorkbook()
'Created by XXXX 5/2/2014
Application.ScreenUpdating = False ' turn off the screen updating
Dim wb As Workbook
Set wb = Workbooks.Open("LOCATION OF FILE", True, True)
' open the source workbook, read only
With ThisWorkbook.Worksheets("1")
' read data from the source workbook: (Left of (=) is paste # destination, right of it is copy)
.Range("F8:K25").Value = wb.Worksheets("1").Range("F8:K25").Value
End With
With ThisWorkbook.Worksheets("2")
' read data from the source workbook: (Left of (=) is paste # destination, right of it is copy)
.Range("V5:Z359").Value = wb.Worksheets("2").Range("V5:Z359").Value
End With
wb.Close False ' close the source workbook without saving any changes
Set wb = Nothing ' free memory
Application.ScreenUpdating = True ' turn on the screen updating
End Sub
The problem I'm having is this: every once and a while, I'll need to add a new product, which adds a row on the master (this is opposed to adding data, which is just added across the row). Sometimes this row is at the end, sometimes it's in the middle. As you can see from the code below, my VBA currently can't handle this row change as it is just copy/pasting from a predefined range. Each users's workbook does not pick up on this change in row # and thus the data in the colums becomes associated with the wrong rows. Normally, you could just copy the entire sheet and problem solved. The issue I have is that each user needs to be able to record their own process in their own workbook next to their data. Is there a way to code this so that a new row on the master sheet will be accounted for and added to all the others without erasing/moving the marks made by each user? I've been trying to find a way to make it "insert" rows if they're new in the master, as this would preserve the data, but can't figure it out. Also, due to security on the server at work- linking workbooks, etc is not an option. Does anyone have any thoughts on this?
One way to approach this problem would be using the Scripting.Dictionary Object. You could create a dictionary for both the target and source identifiers and compare those. I suppose you don't really need the Key-Value pair to achieve this, but hopefully this gets you on the right track!
Sub Main()
Dim source As Worksheet
Dim target As Worksheet
Dim dictSource As Object
Dim dictTarget As Object
Dim rng As Range
Dim i As Integer
Dim j As Integer
Dim idSource As String
Dim idTarget As String
Dim offset As Integer
Set source = ThisWorkbook.Sheets(2)
Set target = ThisWorkbook.Sheets(1)
offset = 9 'My data starts at row 10, so the offset will be 9
Set rng = source.Range("A10:A" & source.Cells(source.Rows.Count, "A").End(xlUp).Row)
Set dictSource = CreateObject("Scripting.Dictionary")
For Each cell In rng
dictSource.Add Key:=cell.Value, Item:=cell.Row
Next
Set rng = target.Range("A10:A" & target.Cells(target.Rows.Count, "A").End(xlUp).Row)
Set dictTarget = CreateObject("Scripting.Dictionary")
For Each cell In rng
dictTarget.Add Key:=cell.Value, Item:=cell.Row
Next
i = 1
j = source.Range("A10:A" & source.Cells(source.Rows.Count, "A").End(xlUp).Row).Rows.Count
Do While i <= j
Retry:
idSource = source.Cells(i + offset, 1).Value
idTarget = target.Cells(i + offset, 1).Value
If Not (dictSource.Exists(idTarget)) And idTarget <> "" Then
'Delete unwanted rows
target.Cells(i + offset, 1).EntireRow.Delete
GoTo Retry
End If
If dictTarget.Exists(idSource) Then
'The identifier was found so we can update the values here...
dictTarget.Remove (idSource)
ElseIf idSource <> "" Then
'The identifier wasn't found so we can insert a row
target.Cells(i + offset, 1).EntireRow.Insert
'And you're ready to copy the values over
target.Cells(i + offset, 1).Value = idSource
End If
i = i + 1
Loop
Set dictSource = Nothing
Set dictTarget = Nothing
End Sub